Question

我在网站上找到了不同的解决方案，但它们并没有解决我的问题。以下部分是查找的结果，其中“FoundCell”地址返回到工作表。我试图做的是将“FoundCell”地址返回到单元格（1,1），其余地址直接在下面。我想要我的调试行在电子表格上打印的内容。

Value Found In Cell: $F$2
Value Found In Cell: $F$5
Value Found In Cell: $F$8
Value Found In Cell: $F$9

工作表“程序索引”包含A到F列。我正在使用Find来搜索F列中逗号分隔的字符串。目前，代码返回F列中找到字符串的单元格地址。我需要的是A和A列中的条目。 B与F列中找到的地址相关联。

Sub Find()

Dim SearchRange As Range
Dim FoundCells As Range
Dim FoundCell As Range
Dim Destination As Range
Dim c, d As Range
Dim Row As String


Dim FindWhat As Variant
Dim FindWhat2 As Variant


Set Destination = Sheets("Calculations").Cells(1, 1)
Set SearchRange = Sheets("Program Index").Range("F2:F1000")

Debug.Print Sheets("main").Range("F2")

Sheets("Calculations").Range("A2:A50").Clear

FindWhat = Sheets("Main").Range("F2")
FindWhat2 = "All"

Set FoundCells = FindAll(SearchRange:=SearchRange, _
                        FindWhat:=FindWhat, _
                        LookIn:=xlValues, _
                        LookAt:=xlPart, _
                        SearchOrder:=xlByColumns, _
                        MatchCase:=False, _
                        BeginsWith:=vbNullString, _
                        EndsWith:=vbNullString, _
                        BeginEndCompare:=vbTextCompare)

If FoundCells Is Nothing Then
    Debug.Print "Value Not Found"
Else
    Set c = Sheets("Calculations").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    For Each FoundCell In FoundCells
         c.Value = FoundCell.Address   
         Set c = c.Offset(1, 0)
    Next FoundCell
End If

    Set FoundCells = FindAll(SearchRange:=SearchRange, _
                            FindWhat:=FindWhat2, _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByColumns, _
                            MatchCase:=False, _
                            BeginsWith:=vbNullString, _
                            EndsWith:=vbNullString, _
                            BeginEndCompare:=vbTextCompare)

If FoundCells Is Nothing Then
    Debug.Print "Value Not Found"
Else
    Set c = Sheets("Calculations").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    For Each FoundCell In FoundCells
         c.Value = FoundCell.Address
         Set c = c.Offset(1, 0)
    Next FoundCell
End If

End Sub

我相信我需要的改变应该发生在“FindAll”中，但是我不知道在哪里修改。

If Not FoundCell Is Nothing Then
    Set FirstFound = FoundCell

    Do Until False ' Loop forever. We'll "Exit Do" when necessary.
        Include = False
        If BeginsWith = vbNullString And EndsWith = vbNullString Then
            Include = True
        Else
            If BeginsWith <> vbNullString Then
                If StrComp(Left(FoundCell.Text, Len(BeginsWith)), BeginsWith, BeginEndCompare) = 0 Then
                    Include = True
                End If
            End If
            If EndsWith <> vbNullString Then
                If StrComp(Right(FoundCell.Text, Len(EndsWith)), EndsWith, BeginEndCompare) = 0 Then
                    Include = True
                End If
            End If
        End If
        If Include = True Then
            If ResultRange Is Nothing Then
                Set ResultRange = FoundCell
            Else
                Set ResultRange = Application.Union(ResultRange, FoundCell)
            End If
        End If
        Set FoundCell = SearchRange.FindNext(after:=FoundCell)
        If (FoundCell Is Nothing) Then
            Exit Do
        End If
        If (FoundCell.Address = FirstFound.Address) Then 'modify to find program number and description
            Exit Do
        End If

    Loop
End If

Set FindAll = ResultRange

Answer 1

 FoundCell.Copy Sheets("Calculations").Cells(Rows.Count, 1).End(xlUp).Offset(1,0)

编辑：也许这就是您正在寻找的内容：

Dim c as range

If FoundCells Is Nothing Then
    Debug.Print "Value Not Found"
Else
    Set c = Sheets("Calculations").Cells(Rows.Count, 1).End(xlUp).Offset(1,0)
    For Each FoundCell In FoundCells
         Debug.Print "Value Found In Cell: " & FoundCell.Address
         c.value = FoundCell.Address()
         'add values from the same row as FoundCell
         c.offset(0, 1).value = FoundCell.EntireRow.Cells(1).value 'from colA
         c.offset(0, 2).value = FoundCell.EntireRow.Cells(2).value 'from colB
         Set c = c.offset(1,0)
    Next FoundCell
End If

Answer 2

要使您的debug.print行显示在A列，第1行到第n行，您可以执行以下操作：

Dim FoundCells As Range, FoundCell As Range
Dim rDest As Range
Set rDest = Worksheets("Calculations").Range("A1")

'For testing
Set FoundCells = Union(Range("f2"), Range("f5"), Range("f8"), Range("f9"))

If FoundCells Is Nothing Then
        rDest.Value = "Value Not Found"
    Else
        For Each FoundCell In FoundCells
             rDest.Value = "Value Found In Cell: " & FoundCell.Address
             Set rDest = rDest(2, 1)
        Next FoundCell
    End If

第一个空单元格

2 个答案: