gpt4 book ai didi

如果值在列中,则 Excel vba

转载 作者:行者123 更新时间:2023-12-04 21:51:30 24 4
gpt4 key购买 nike

关闭。这个问题需要更多 focused .它目前不接受答案。












想改进这个问题?更新问题,使其仅关注一个问题 editing this post .


3年前关闭。







Improve this question




我想通过 if then else 函数制作一个宏(也许使用循环)。

我有两个单独的文件,名为“orderregistratie”+“werkorder 模板”。
我想在 orderregistratie 的 sheet("datablad") 列 A 中搜索 werkorder 模板中的值 sheet("export datablad").Range("A2")。

如果此值存在于 A 列中,则从导出数据库复制 A2 的行并将其粘贴到找到该值的行中。
如果它尚不存在,我想在 orderregistratie 中的 A2 处插入一个新行,并从新行中的 export datablad 复制 A2 行。

我的 VBA 知识不是很好,我不能自己编写宏。有谁能帮我写吗?

最佳答案

试试这个。我会根据需要进行调整。只需仔细检查两个工作簿是否都保存到您的桌面。

Option Explicit

Private wkbOrderReg As Workbook, _
wkbOrderWork As Workbook, _
wkb As Workbook

Private wsOBJ As Worksheet, _
ws As Worksheet

Private rngSearch As Range, _
rngRow As Range, _
rng As Range, _
r As Range

Private strSearch As String

Public Sub DarudeSandStorm()
Dim LastRow As Long, _
LastColumn As Long
Dim arr As Variant
With Application.Workbooks
Set wkbOrderReg = .Open(Filename:=strVar("orderregistratie.xlsx"))
Set wkbOrderWork = .Open(Filename:=strVar("werkorder template.xlsx"))
End With
With wkbOrderWork
For Each ws In .Worksheets
Set wsOBJ = ws
If UCase$(wsOBJ.Name) = UCase$("export datablad") Then
With wsOBJ
Set rng = .Range(.Cells(2, 1), .Cells(2, 1))
strSearch = rng.Value
LastColumn = getLAST_COLUMN(wsOBJ)
Set rngRow = .Range(.Cells(2, 1), .Cells(2, LastColumn))
End With
arr = rngRow
Exit For
End If
Next ws
End With
With wkbOrderReg
For Each ws In .Worksheets
Set wsOBJ = ws
If UCase$(wsOBJ.Name) = UCase$("export datablad") Then
With wsOBJ
LastRow = getLAST_ROW(wsOBJ)
Set rngSearch = .Range(.Cells(1, 1), .Cells(LastRow, 1))
End With
For Each r In rngSearch
If UCase$(r.Value) = UCase$(strSearch) Then
r = arr
End If
Next r
End If
Next ws
End With
With Application
For Each wkb In .Workbooks
If Not wkb = .ThisWorkbook Then
With .Workbooks(wkb.Name)
.Save
.Close
End With
End If
Next wkb
End With
End Sub

Private Function getLAST_COLUMN(objWS As Worksheet) As Long
Dim wsDES As Worksheet, _
wkbSUB As Workbook, _
rngCHECK As Range
Set rngCHECK = objWS.Cells.Find(What:="*", _
After:=Range("A1"), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not rngCHECK Is Nothing Then
getLAST_COLUMN = objWS.Cells.Find("*", _
Range("A1"), _
xlFormulas, _
, _
xlByColumns, _
xlPrevious).Column
Else
getLAST_COLUMN = 1
End If
End Function

Private Function getLAST_ROW(objWS As Worksheet) As Long
Dim wsDES As Worksheet, _
wkbSUB As Workbook, _
rngCHECK As Range
Set rngCHECK = objWS.Cells.Find(What:="*", _
After:=Range("A1"), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not rngCHECK Is Nothing Then
getLAST_ROW = objWS.Cells.Find("*", _
Range("A1"), _
xlFormulas, _
, _
xlByRows, _
xlPrevious).Row
Else
getLAST_ROW = 1
End If
End Function

Private Function strVar(ByRef str As String) As String
strVar = Environ("Userprofile") & "\Desktop\" & str
End Function

关于如果值在列中,则 Excel vba,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/53079621/

24 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com