-1

我有一些代码在工作簿的 sheet1 中搜索字符串“dog”，该字符串可以在工作表中出现多次，如果在这些列中找到该字符串，它会给我一个列号向量，（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 中这样做的最佳方法是什么？

4

1 回答 1

3

您必须将所有动物存储在另一个中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
于 2013-09-26T08:10:04.027 回答