Question

我有一些代码在工作簿的sheet1中搜索字符串“dog”，该字符串可以在工作表中多次出现，如果在这些列中找到字符串，它会给我一个列号的向量，（狗每列只能出现一次）。我在工作表上有一个按钮，我指定了这个宏：

Option Explicit


Sub mymacro2()
Dim dog() As Integer
Dim coldog As Range
Set coldog = Sheets(1).UsedRange.Find("dog", , xlValues, xlWhole)
Dim i As Integer
i = 0
ReDim dog(0)
dog(i) = coldog.Column
Do
    i = i + 1
    ReDim Preserve dog(i)
    Set coldog = Sheets(1).UsedRange.FindNext(coldog)
    dog(i) = coldog.Column
Loop While dog(i) <> dog(0)

ReDim Preserve dog(i - 1)



Sheets(1).Cells(1, 1).Resize(1, UBound(Application.Transpose(dog))) = dog
'above line is displaying the vector on the sheet for testing purposes
Set coldog = Nothing

ReDim dog(0)


End Sub

宏给了我想要的矢量，即它告诉我在哪些列中我可以找到字符串“dog”。

现在，我想修改代码或创建一个全新的代码，为sheet2第1列中找到的字符串列表中的每个字符串执行相同的操作。具有列号的所有向量必须与其具有列信息的字符串具有相同的名称。就像我在上面的代码中手动做的那样。

关键是我有一份大约130只动物的清单，我需要做同样的事情。在Excel VBA中执行此操作的最佳方法是什么？

Answer 1

您必须将所有动物存储在另一个Array中并为每个动物调用给定的动作。您的代码也有相当多的冗余部分。下面的示例代码应该让您很好地理解如何面对这个问题（正如Mehow的评论所说，我们不是为您编写代码）。

Dim totAnimals As Integer, i As Integer
totAnimals = 3
ReDim animals(totAnimals - 1) As String
animals(0) = "dog"
animals(1) = "cat"
animals(2) = "mouse"
'etc.

maxMatches = 100 'Maximum number of matches per animal. better don't make this value too big
ReDim matchCount(totAnimals - 1) 'This counter goes from 1 to maxMatches
ReDim matchCols(totAnimals - 1, maxMatches) As Integer

Dim targetRange As Range, tempRange As Range, tempRange2 As Range
Set targetRange = Sheets("sheet2").Columns(1)

For i = 0 To totAnimals - 1
    Set tempRange = targetRange.Find(animals(i), , xlValues, xlWhole)
    If (Not tempRange Is Nothing) Then
        If (matchCount(i) + 1 <= maxMatches) Then
            matchCount(i) = matchCount(i) + 1

            matchCols(i, matchCount(i)) = tempRange.Column
            Dim startAddress As String: startAddress = tempRange.Address
            Set tempRange2 = tempRange
            Do
                Set tempRange2 = targetRange.FindNext(tempRange2)
                If (Not tempRange2 Is Nothing) Then
                    If (tempRange2.Address = startAddress) Then Exit Do
                Else
                    Exit Do
                End If
                If (matchCount(i) + 1 > maxMatches) Then Exit Do
                matchCount(i) = matchCount(i) + 1
                matchCols(i, matchCount(i)) = tempRange2.Column
            Loop While (Not tempRange2 Is Nothing)
        End If
    End If
Next i

如果列包含字符串，则列出列号

1 个答案: