时间戳

首页 > 解决方案 > VBA嵌套循环 - 外循环不跳转到下一个值

vba - VBA嵌套循环 - 外循环不跳转到下一个值

问题描述

我正在尝试做一个宏来生成一个基于查找列表的列表。由于某种原因，外循环不起作用，它只迭代一次。

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”列表的下一个值。我是新手，所以希望有一个简单的解决方案，但任何帮助都将不胜感激

标签： vbaloopslookup

解决方案

带偏移的循环

  • 问题是您没有Lookup Range在每个内部循环完成后将其重置为初始位置。所以下面的循环试图比较下面的值Lookup Range是空的。
  • 您应该放弃“偏移”的想法并使用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

推荐阅读