Question

我有一份数据表。让我们说“A”栏中有一堆狗品种：Lab，Beagle，Golden和Poodle。

列“B”有他们的名字。有很多狗都是由这四个品种组成的，都有不同的名字。

列“C”的位置：纽约，德克萨斯，路易斯安那和佛罗里达

我想要做的是编写一个脚本，在列“A”中搜索所有居住在纽约的实验室。一旦脚本找到这些狗，它就会抓住它们的名字，并将它们的名字放在一个单独的工作表上。

我需要为所有狗做到这一点。单独的工作表应该有纽约，德克萨斯，路易斯安那和佛罗里达州的列表，其下面有所有的狗名。我计划根据品种对狗的名字进行颜色编码。

我原以为我可以使用Find方法，但老实说，我没有过多地使用VBA，而且我的谷歌搜索并没有太成功。谢谢你的帮助

Answer 1

尝试这样的事情。根据需要调整。

Option Explicit

Sub TestDogs()
Dim dogBreed As String
Dim dogName As String
Dim dogLoc As String
Dim rngFound As Range
Dim wsMaster As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim arrDogs() As String
Dim i As Long

Set wsMaster = Worksheets("List") '<modify as needed.'
wsMaster.Activate
Range("A1").Activate
dogBreed = InputBox("Enter the breed", "Dog Breed", "Lab")
dogLoc = InputBox("Enter the location", "Dog location", "New York")

Set rng = Range("A1", Range("a1").End(xlDown))
Range("A1").Activate
Do
    'use the .Find method to look for dog breed in column A'

    Set rngFound = rng.Find(What:=dogBreed, After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=True, SearchFormat:=False)

    If Not rngFound Is Nothing Then
        rngFound.Activate
        'Check to see if the Location matches:'
        If rngFound.Offset(0, 2).Value = dogLoc Then
            dogName = rngFound.Offset(0, 1).Value
            'If so, then add to the array'
            ReDim Preserve arrDogs(i)
            arrDogs(i) = dogName
            i = i + 1
            If i >= Application.WorksheetFunction.CountIf(rng, dogBreed) - 1 Then Exit Do
        End If
    Else: Exit Do
    End If

'Loop, the counter variable "i" will exit this loop when necessary.
Loop

If UBound(arrDogs) >= 0 Then
    'Add a new sheet if any matches were found
    Set wsNew = Sheets.Add(After:=wsMaster)

    With wsNew
        'Give the sheet a meaningful name.'
        .Name = Left(dogBreed & " - " & dogLoc, 31)
        'Print out the dog names on the new sheet'
        .Range("A1", .Range("A1").Offset(UBound(arrDogs), 0)).Value = WorksheetFunction.Transpose(arrDogs)
    End With
Else:
    MsgBox "No dogs matching criteria [Breed =" & dogBreed & "] and [Location =" & dogLoc & "]", vbInformation

End If
End Sub

将名称排序到VBA中的相应列中

1 个答案: