我有一个VBA脚本,用于搜索H列中的一个值,如果同一行的D-G列中存在第二个值,它应该修改I列中的数量。如果在该行中找不到该值,则它应该继续寻找。
这对于大多数条目都适用,但在某些条目上,有太多潜在代码无法容纳在 4 列中,因此我在 H 列中具有相同值的某些部分上添加了另一行,但其余的它应该在 D-G 列中查找的值。因为脚本应该检查 H 列,找到值 1,检查 D-G 列是否有值 2,如果没有找到,则继续搜索,我认为它会继续到下一行并找到它要查找的内容。然而,事实并非如此。 如果它寻找的第二个值位于顶部,那么它可以很好地找到正确的行,但如果它位于第二行,则它找不到它。我已经包含了 Excel 工作表的片段作为示例。
Private Sub RemoveStock_Click()
Dim EmptyRange As Range
ThisWorkbook.Sheets("Log").Range("J1").Value = UserForm1.TextBox1.Text
ThisWorkbook.Sheets("Log").Range("J2").Value = UserForm1.TextBox2.Text
ThisWorkbook.Sheets("Log").Range("J3").Value = UserForm1.TextBox3.Text
ThisWorkbook.Sheets("Log").Range("J4").Value = UserForm1.TextBox4.Text
If ThisWorkbook.Sheets("Log").Range("J3").Value = "" Then
MsgBox "no Quantity has been entered"
End If
Range("H4").Select
Dim BHM
Dim DT
Dim BHMrng As Range
Dim DTrng As Range
Dim rnmb
Dim cel As Range
Dim found
found = ThisWorkbook.Sheets("Log").Range("Z4").Value
BHM = ThisWorkbook.Sheets("Log").Range("J1").Value
DT = ThisWorkbook.Sheets("Log").Range("J2").Value
Range("H4").Activate
Dim x As Long
For x = 1 To 10
On Error Resume Next
Set DTrng = ThisWorkbook.Sheets("Inventory").Columns("H:H").Find(DT, Range("H" & ActiveCell), xlValues, xlWhole, 1, 1, 0)
If Not DTrng Is Nothing Then
DTrng.Activate
For Each cel In Range(DTrng.Offset(0, -4), DTrng.Offset(0, -1))
If cel.Value = BHM Then
DTrng.Offset(0, 1).Value = DTrng.Offset(0, 1).Value + ThisWorkbook.Sheets("Log").Range("J3").Value
found = "1"
ElseIf cel.Value = "Misc." Then
DTrng.Offset(0, 1).Value = DTrng.Offset(0, 1).Value + ThisWorkbook.Sheets("Log").Range("J3").Value
found = "1"
End If
If found = "1" Then
Exit For
End If
Next cel
If found = "1" Then
Exit For
End If
End If
Next x
If found = "" Then
MsgBox "no matching BHM for Detail #"
End If
If found = "1" Then
found = ""
End If
ThisWorkbook.Sheets("Log").Range("J1:J4").ClearContents
End Sub
工作表:
匹配
DT
值时,可以检查I列是否有合并单元格,然后在D:G列中搜索相关行
未经测试:
Private Sub RemoveStock_Click()
Dim wsLog As Worksheet, wsInv As Worksheet
Dim BHM, DT, cel As Range, found, v
Dim r As Long, lr As Long, iColRows As Long
Set wsLog = ThisWorkbook.Sheets("Log")
Set wsInv = ThisWorkbook.Sheets("Inventory")
wsLog.Range("J1").Value = Me.TextBox1.Text 'use `Me` if this code is in a userform
wsLog.Range("J2").Value = Me.TextBox2.Text
wsLog.Range("J3").Value = Me.TextBox3.Text
wsLog.Range("J4").Value = Me.TextBox4.Text
If wsLog.Range("J3").Value = "" Then
MsgBox "no Quantity has been entered"
Exit Sub '?????
End If
found = wsLog.Range("Z4").Value 'what is this for?
BHM = wsLog.Range("J1").Value
DT = wsLog.Range("J2").Value
r = 2 'start checking here...
lr = wsInv.Cells(Rows.Count, "H").End(xlUp).Row 'last value in col H
Do While r <= lr
If wsInv.Cells(r, "H").Value = DT Then
iColRows = wsInv.Cells(r, "I").MergeArea.Rows.Count '?Col I is merged?
'check each cell in (D to G) x (# of merged rows in Col I)
For Each cel In wsInv.Cells(r, "D").Resize(iColRows, 4).Cells
v = cel.Value
If v = BHM Or v = "Misc." Then
With wsInv.Cells(r, "I")
.Value = .Value & wsLog.Range("J3").Value 'increment amount
found = "1"
Exit Do 'done searching...
End With
End If
Next cel
r = r + (iColRows - 1) 'not matched, so skip to last "Extra" row before continuing the search
End If
r = r + 1 'increment search row
Loop
If found <> "1" Then MsgBox "no matching BHM for Detail #"
wsLog.Range("J1:J4").ClearContents
End Sub