Question

我环顾四周，但没有关于我遇到的特殊问题的帖子。我试图连续找到GGID（id）和国家/地区的组合。在我的工作表中，有4行具有给定的GGID但具有不同的国家/地区，然后超过1000行与其他ggids，然后是正确的GGID和正确的国家/地区。

该功能如下所示：

Function rangefinder2(ByVal ggid As Long, ByRef sheet As Worksheet, ByVal country) As Object

Dim wbMain As Workbook
Set wbMain = ThisWorkbook
Dim loopback As Long
Dim x As Integer, y As Integer, z As Long
Dim adresik As Long
loopback = 1

    For x = 1 To 15
        If sheet.Cells(1, x) = "Pays" Then Exit For
    Next x
    For y = 1 To 15
        If sheet.Cells(1, y) = "GGID" Then Exit For
    Next y

    z = sheet.range("A1").CurrentRegion.Rows.Count
    sheet.Activate      'AST: if you remove this, next line throws an error

    Do

        If Not IsError(Application.Match(CLng(ggid), _
                       sheet.range(Cells(loopback, y), Cells(z, y)), 0)) Then

            adresik = Application.Match(ggid, _
                      sheet.range(Cells(loopback, y), Cells(z, y)), 0)

            If Cells(adresik + loopback, x) = country Then
                Set rangefinder2 = Cells(adresik + loopback, y)
                Exit Function
            End If
        Else
            Set rangefinder2 = Nothing
            Exit Function
        End If

        If loopback = 1 Then
            loopback = adresik
        Else
            loopback = loopback + adresik
        End If
    Loop

End Function

注释：工作表正确传递（我使用sheet.name检查），正确计算值x，y和z。匹配找到前四行（67-71），但后来找不到最后一行（1600）。值z（代表范围的结束）是1601.我不明白：/我的帮助将不胜感激。

所以我制作了一个测试数组来说明这一点：

Answer 1

'Find the cells having formulas in sheet and add it to dictionaries
Function FindAllInSheet() As Scripting.Dictionary

    Dim sFormulaKey As String
    Dim wks As Worksheet
    Dim formulaDict As New Scripting.Dictionary
    Dim fRange As Range, strFirstAdd As String


    Set wks = ActiveSheet
    sFormulaKey = "=TEST"
    Set formulaDict = New Scripting.Dictionary

    'find the project name
    Set fRange = wks.Cells.Find(what:=sFormulaKey, SearchDirection:=xlNext, LookAt:=xlPart)

    If Not fRange Is Nothing Then

        'get the address of the first occurence
        strFirstAdd = fRange.Address
        If Not formulaDict.Exists(fRange.Address) Then
            formulaDict.Add fRange.Address, fRange.Formula
        End If

        'loop till  project name range is not found or first address is reached
        Do
            Set fRange = wks.Cells.Find(what:=sFormulaKey, After:=fRange, SearchDirection:=xlNext, LookAt:=xlPart)

            If fRange Is Nothing Then
                Exit Do
            End If

            If fRange.Address = strFirstAdd Then
                Exit Do
            End If

            If Not formulaDict.Exists(fRange.Address) Then
                formulaDict.Add fRange.Address, fRange.Formula
            End If

        Loop While Not fRange Is Nothing

        'Return the Dictionary
        Set FindAllInSheet = formulaDict

    End If

End Function


'Find the cell having formulas in selected range and add it to dictionaries
Function FindAllInSelection() As Scripting.Dictionary

    Dim sFormulaKey As String
    Dim wks As Worksheet
    Dim formulaDict As New Scripting.Dictionary
    Dim fRange As Range, strFirstAdd As String


    Set wks = ActiveSheet
    sFormulaKey = "=TEST"
    Set formulaDict = New Scripting.Dictionary

    For Each fRange In Selection
        If InStr(LCase(fRange.Formula), LCase(sFormulaKey)) > 0 Then
            If Not formulaDict.Exists(fRange.Address) Then
                formulaDict.Add fRange.Address, fRange.Formula
            End If
        End If
    Next fRange

    'Return the Dictionary
    Set FindAllInSelection = formulaDict



End Function

VBA application.match未在查找范围中找到所有值

1 个答案: