首页 > 解决方案 > 根据行号将单元格从 Sheet1 中的 B:D 列复制到 Sheet2 中的 C:E

问题描述

我有一个工作表(Sheet2),其中在 B:D 列的不同行号处粘贴了行。

这些行号实际上与工作表(Sheet1)中的行号相对应,这些行号是空白的,我希望将单元格动态粘贴到 C:E 列中。

我有以下代码,只要我知道 C 列中单元格的范围,我就可以根据文本值 =“LAW”从 B:D 列复制行并粘贴到 Sheet1 中。

我想我正在寻找的相当于找到“LAW”时,将行与Sheet1中的行匹配并粘贴到C列。循环是必要的,因为在其他情况下找到“LAW”并且这些单元格需要粘贴在适当的单元格范围内。

    Dim WBT As Workbook
    Dim WSD1 As Worksheet
    Dim WSD2 As Worksheet

    Set WBT = Workbooks("Invoices.csv")
    Set WSD1 = WBT.Worksheets("Sheet1")
    Set WSD2 = WBT.Worksheets("Sheet2")


    Set r2 = WSD1.Range("C11")

    With WSD2
        N = .Cells(Rows.Count, "B").End(xlUp).row
        For i = 1 To N
           If .Cells(i, "B").Value = "LAW" Then
                Set r1 = Range(.Cells(i, "B"), .Cells(N, "D"))
                r1.Copy r2
           End If
        Next i
    End With

我发现想出一个故障安全解决方案相当困难,但是我希望有人能给我一些指示,告诉我应该如何去做。

下面的示例演示了我要查找 Sheet2 中的行并将它们粘贴到 Sheet1 中突出显示的点。如果有一种动态方式表示如果 Sheet2 上 B 列中的文本 = LAW,则将该行(从 B 列到 D 列)复制到 Sheet1 中的等效行。在我的示例中,我有两个发生这种情况的实例。

Sheet2 到Sheet1 示例

在@SJR 成功修改脚本之后,我遇到了一个问题,即工作簿有很多张。所以我修改了代码并使用了一个函数来测试一张表是否存在(默认为不存在)

Function SheetExists(shtName As String, Optional wb As Workbook) As Boolean
Dim sht As Worksheet

If wb Is Nothing Then Set wb = ThisWorkbook
On Error Resume Next
Set sht = wb.Sheets(sht)
On Error Resume Next
SheetExists = Not sht Is Nothing
End Function

并复制代码如下:

Dim r1 As Range
Dim r2 As Range
Dim N As Long
Set r2 = WSD1.Range("C1:C100")

With WSD2
    If Not SheetExists("Sheet1") Then
        N = .Cells(Rows.Count, "B").End(xlUp).row
                For i = 1 To N
                    If .Cells(i, "B").Value = "LAW" Then
                        Set r1 = Range(.Cells(i, "B"), .Cells(i, "D"))
                        r1.Copy WSD1.Cells(i, "C")
                    End If
                Next i
    Else
        On Error Resume Next
    End If
End With

With WSD3
    If Not SheetExists("Sheet2") Then
        N = .Cells(Rows.Count, "B").End(xlUp).row
                For i = 1 To N
                    If .Cells(i, "B").Value = "LAW" Then
                        Set r1 = Range(.Cells(i, "B"), .Cells(i, "D"))
                        r1.Copy WSD1.Cells(i, "C")
                    End If
                Next i
    Else
       On Error Resume Next
    End If
End With

虽然这在工作簿有 2 张工作表的情况下工作正常,但它在第二个引用 WSD3 的脚本上N = .Cells(Rows.Count, "B").End(xlUp).row出现运行时错误“91”。通过单步执行代码,我发现如果您将鼠标悬停在 Range 上,R1 的变量会出现消息????虽然我试图弄清楚为什么它说变量没有设置,但我很困惑。

标签: excelexcel-2016vba

解决方案


你能试试这个吗?认为您在分配 r1 的行中有错误的 N。

Sub x()

Dim WBT As Workbook
Dim WSD1 As Worksheet
Dim WSD2 As Worksheet, N As Long

Set WBT = Workbooks("Invoices.csv")
Set WSD1 = WBT.Worksheets("Sheet1")
Set WSD2 = WBT.Worksheets("Sheet2")
Set r2 = WSD1.Range("C11")

With WSD2
    N = .Cells(Rows.Count, "B").End(xlUp).Row
    For i = 1 To N
       If .Cells(i, "B").Value = "LAW" Then
            Set r1 = .Range(.Cells(i, "B"), .Cells(i, "D"))
            r1.Copy WSD1.Cells(i, "C")
       End If
    Next i
End With

End Sub

推荐阅读