VBA 嵌套循环 - 外循环不跳转到下一个值
VBA nested loop - outer loop doesnt jump to next value
我正在尝试做一个宏来根据查找列表生成列表。由于某种原因,外循环不起作用,它只迭代一次。
Sub Macro5()
Dim LookupRng As Range
Dim Store As String
Dim jrow As Integer
Dim irow As Integer
Dim i As Integer
Dim j As Integer
Set LookupRng = Sheet1.Range("B2") ' The Lookup range
jrow = Sheet2.Range("T" & Rows.Count).End(xlUp).Row ' last row of list of values to be searched
irow = Sheet1.Range("B" & Rows.Count).End(xlUp).Row ' last row of lookup range
Sheet3.Range("A2:A" & Rows.Count).Clear
For j = 2 To jrow
Store = Sheet2.Cells(j, 20).Value ' the value to be searched in the lookup range
For i = 1 To irow
If LookupRng.Value = Store Then
Sheet3.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = LookupRng.Offset(0, -1).Value
End If
Set LookupRng = LookupRng.Offset(1, 0)
Next i
Next j
i 循环有效,它搜索与“Store”匹配的所有值,但由于某种原因 j 循环似乎不起作用,它没有跳转到“Store”列表的下一个值。
我是新手,所以希望有一个简单的解决方案,但非常感谢任何帮助
带偏移的循环
- 问题是您没有在每个内循环完成后将
Lookup Range
重置到初始位置。因此,以下循环试图比较 Lookup Range
以下的空值。
- 您应该放弃 'offsetting' 的想法并使用
Cells
或 Range
并增加行数或定义范围并使用 For Each
循环。但最好的办法是只使用一个循环并使用 Application.Match
找到匹配项。
快速修复
Option Explicit
Sub lookupLoop()
Dim ilCell As Range ' Initial Lookup Cell Range
Dim lCell As Range ' Lookup Cell Range
Dim dCell As Range ' Destination Cell Range
Dim Store As Variant ' Current Value in Search Range
Dim iRow As Long ' Last Row of Lookup Range
Dim jRow As Long ' Last Row of Search Range
Dim i As Long ' Lookup Range Rows Counter
Dim j As Long ' Search Range Rows Counter
Set ilCell = Sheet1.Range("B2")
iRow = Sheet1.Range("B" & Sheet1.Rows.Count).End(xlUp).Row
jRow = Sheet2.Range("T" & Sheet2.Rows.Count).End(xlUp).Row
Sheet3.Range("A2:A" & Sheet3.Rows.Count).Clear
Set dCell = Sheet3.Range("A2")
For j = 2 To jRow
Store = Sheet2.Cells(j, "T").Value
Set lCell = ilCell '***
For i = 2 To iRow
If lCell.Value = Store Then
dCell.Value = lCell.Offset(0, -1).Value
Set dCell = dCell.Offset(1)
Exit For
End If
Set lCell = lCell.Offset(1)
Next i
Next j
End Sub
Application.Match
解决方案可能如下所示:
Sub lookupAM()
Dim lrg As Range ' Lookup Range (Read)
Dim vrg As Range ' Values Range (Write)
Dim srg As Range ' Search Range
Dim sCell As Range ' Current Cell in Search Range
Dim dCell As Range ' Current Cell in Destination Range
Dim cMatch As Variant ' Current Match
Dim lRow As Long ' Last Row of Lookup Range
Dim sRow As Long ' Last Row of Search Range
lRow = Sheet1.Range("B" & Sheet1.Rows.Count).End(xlUp).Row
Set lrg = Sheet1.Range("B2:B" & lRow)
Set vrg = lrg.Offset(, -1)
sRow = Sheet2.Range("T" & Sheet2.Rows.Count).End(xlUp).Row
Set srg = Sheet2.Range("T2:T" & sRow)
Sheet3.Range("A2:A" & Sheet3.Rows.Count).Clear
Set dCell = Sheet3.Range("A2")
For Each sCell In srg.Cells
cMatch = Application.Match(sCell.Value, lrg, 0)
If IsNumeric(cMatch) Then
dCell.Value = vrg.Cells(cMatch).Value
End If
Set dCell = dCell.Offset(1)
Next sCell
End Sub
我正在尝试做一个宏来根据查找列表生成列表。由于某种原因,外循环不起作用,它只迭代一次。
Sub Macro5()
Dim LookupRng As Range
Dim Store As String
Dim jrow As Integer
Dim irow As Integer
Dim i As Integer
Dim j As Integer
Set LookupRng = Sheet1.Range("B2") ' The Lookup range
jrow = Sheet2.Range("T" & Rows.Count).End(xlUp).Row ' last row of list of values to be searched
irow = Sheet1.Range("B" & Rows.Count).End(xlUp).Row ' last row of lookup range
Sheet3.Range("A2:A" & Rows.Count).Clear
For j = 2 To jrow
Store = Sheet2.Cells(j, 20).Value ' the value to be searched in the lookup range
For i = 1 To irow
If LookupRng.Value = Store Then
Sheet3.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = LookupRng.Offset(0, -1).Value
End If
Set LookupRng = LookupRng.Offset(1, 0)
Next i
Next j
i 循环有效,它搜索与“Store”匹配的所有值,但由于某种原因 j 循环似乎不起作用,它没有跳转到“Store”列表的下一个值。 我是新手,所以希望有一个简单的解决方案,但非常感谢任何帮助
带偏移的循环
- 问题是您没有在每个内循环完成后将
Lookup Range
重置到初始位置。因此,以下循环试图比较Lookup Range
以下的空值。 - 您应该放弃 'offsetting' 的想法并使用
Cells
或Range
并增加行数或定义范围并使用For Each
循环。但最好的办法是只使用一个循环并使用Application.Match
找到匹配项。
快速修复
Option Explicit
Sub lookupLoop()
Dim ilCell As Range ' Initial Lookup Cell Range
Dim lCell As Range ' Lookup Cell Range
Dim dCell As Range ' Destination Cell Range
Dim Store As Variant ' Current Value in Search Range
Dim iRow As Long ' Last Row of Lookup Range
Dim jRow As Long ' Last Row of Search Range
Dim i As Long ' Lookup Range Rows Counter
Dim j As Long ' Search Range Rows Counter
Set ilCell = Sheet1.Range("B2")
iRow = Sheet1.Range("B" & Sheet1.Rows.Count).End(xlUp).Row
jRow = Sheet2.Range("T" & Sheet2.Rows.Count).End(xlUp).Row
Sheet3.Range("A2:A" & Sheet3.Rows.Count).Clear
Set dCell = Sheet3.Range("A2")
For j = 2 To jRow
Store = Sheet2.Cells(j, "T").Value
Set lCell = ilCell '***
For i = 2 To iRow
If lCell.Value = Store Then
dCell.Value = lCell.Offset(0, -1).Value
Set dCell = dCell.Offset(1)
Exit For
End If
Set lCell = lCell.Offset(1)
Next i
Next j
End Sub
Application.Match
解决方案可能如下所示:
Sub lookupAM()
Dim lrg As Range ' Lookup Range (Read)
Dim vrg As Range ' Values Range (Write)
Dim srg As Range ' Search Range
Dim sCell As Range ' Current Cell in Search Range
Dim dCell As Range ' Current Cell in Destination Range
Dim cMatch As Variant ' Current Match
Dim lRow As Long ' Last Row of Lookup Range
Dim sRow As Long ' Last Row of Search Range
lRow = Sheet1.Range("B" & Sheet1.Rows.Count).End(xlUp).Row
Set lrg = Sheet1.Range("B2:B" & lRow)
Set vrg = lrg.Offset(, -1)
sRow = Sheet2.Range("T" & Sheet2.Rows.Count).End(xlUp).Row
Set srg = Sheet2.Range("T2:T" & sRow)
Sheet3.Range("A2:A" & Sheet3.Rows.Count).Clear
Set dCell = Sheet3.Range("A2")
For Each sCell In srg.Cells
cMatch = Application.Match(sCell.Value, lrg, 0)
If IsNumeric(cMatch) Then
dCell.Value = vrg.Cells(cMatch).Value
End If
Set dCell = dCell.Offset(1)
Next sCell
End Sub