第一個空單元格

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我使用的查找來搜索列F逗號分隔的字符串目前在字符串代碼返回F列單元格地址找到。我需要什麼樣的條目列與發現地址欄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