如果数据可用则读取所有列单元格并使用宏跳过空单元格

Question

我有一个宏读取两张xls工作表，比较数据并将匹配复制到下一列。但我的代码唯一的问题是，如果它之间有任何空单元格，它会停止认为它是文件的结尾。我有一个场景，我在列中有一些空白单元格，我需要阅读，下一行可能有数据。

宏文件：

Sub findAndReplace()
 'Declare working sheet objects
Dim rSh1 As Range, rSh2 As Range, rFound As Range, r As Range

Dim strShortName As String
 strShortName = Cells(2, 3)

 'Check if the source file is opened or not, if not open it
checkFileOpened (strShortName)

 'Read the source file for mapping
With Workbooks(strShortName).Worksheets("sheet1")
    Set rSh1 = .Range("B2", .Range("B2").End(xlDown))
End With
 'Read the current working sheet for given range to match with source data
With Worksheets("sheet1")
    Set rSh2 = .Columns("A:a")
End With
 'Loop through for a match and replace it
For Each r In rSh1
    With r
        Set rFound = rSh2.Find(what:=.Value, lookat:=xlWhole)
        If Not rFound Is Nothing Then
            .Offset(0, 1) = rFound.Offset(0, 1).Value
        Else
        .Offset(0, 1) = "Not Found"
        End If
    End With
Next r
End Sub

Answer 1

尝试将Set rSh1 = .Range("B2", .Range("B2").End(xlDown))替换为Set rSh1 = Range(.Cells(2,2), .Cells(rows.Count,2).End(xlUp))。我没有看到跳过空格(r)的任何逻辑。您也可以添加它。

Sub findAndReplace()

'Declare working sheet objects
Dim rSh1 As Range, rSh2 As Range, rFound As Range, r As Range

Dim strShortName As String
strShortName = Cells(2, 3)

'Check if the source file is opened or not, if not open it
checkFileOpened (strShortName)

'Read the source file for mapping
With Workbooks(strShortName).Worksheets("sheet1")
    Set rSh1 = Range(.Cells(2,2), .Cells(rows.Count,2).End(xlUp))
End With

'Read the current working sheet for given range to match with source data
With Worksheets("sheet1")
    Set rSh2 = .Columns("A:a")
End With

'Loop through for a match and replace it
For Each r In rSh1
    If Not r is Nothing
        Set rFound = rSh2.Find(what:=.Value, lookat:=xlWhole)
        If Not rFound Is Nothing Then
            r.Offset(0, 1) = rFound.Offset(0, 1).Value
        Else
            r.Offset(0, 1) = "Not Found"
        End If
    End If
Next r

End Sub

Answer 2

所以我对@Brian给出的答案做了一点修改，这是我的工作解决方案

Sub findAndReplace()

'Declare working sheet objects
Dim rSh1 As Range, rSh2 As Range, rFound As Range, r As Range

Dim strShortName As String
strShortName = Cells(2, 3)

'Check if the source file is opened or not, if not open it
checkFileOpened (strShortName)

'Read the source file for mapping
With Workbooks(strShortName).Worksheets("sheet1")
  Set LastCellB = .Cells(.Rows.Count, "B").End(xlUp)
    Set rSh1 = .range("B2", LastCellB)

End With
 'Read the current working sheet for given range to match with source data
With Worksheets("sheet1")
    Set rSh2 = .Columns("A:a")
End With
 'Loop through for a match and replace it
For Each r In rSh1
    With r
        Set rFound = rSh2.Find(What:=.Value, LookAt:=xlWhole)
        If Not rFound Is Nothing Then
            .Offset(0, 1) = rFound.Offset(0, 1).Value
        Else
        .Offset(0, 1) = "Not Found"
        End If

    End With
Next r
End Sub