Question

我几乎每天都会查看Stack Overflow以提高我的VBA功能，当我发现一个有趣的问题时，我尝试构建一个可以完成任务的宏。

我的代码执行我想要的操作，它循环播放Sheet2，列“K”并在Sheet1中搜索匹配的列“A”。

当找到匹配项时，代码选择Sheet2中的单元格，“K”列，向右调整5个单元格的大小，并将范围复制到空白的Sheet3，A列。

要将每个范围粘贴到Sheet3上的新行，我必须在Destination：=行上添加.Offset（1）。

如果没有Offset，代码只会覆盖第1行的数据。

但是，使用Offset代码开始在第2行写入数据。

我的解决方法是删除第1行。

我卡住了，有没有办法修复我的代码，所以它开始粘贴第1行的数据范围？代码如下;

Sub test()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet

Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("Sheet2")
Set ws3 = ThisWorkbook.Sheets("Sheet3")

Dim lRow1 As Long, lRow2 As Long, i As Long, j As Long

lRow1 = ThisWorkbook.Sheets("Sheet2").Range("K" & Rows.Count).End(xlUp).Row
lRow2 = ThisWorkbook.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

For i = 1 To lRow1
    For j = 1 To lRow2
        If ws2.Cells(i, 11).Value = ws1.Cells(j, 1).Value Then
            'The part below does what I want it to do, except it skips row 1.
            'If I remove the "Offset.(1)" it just overwrites the data in row 1.
            ws2.Cells(i, 11).Resize(, 5).Copy Destination:=ws3.Range("A" & Rows.Count).End(xlUp).Offset(1)
        End If
    Next j
Next i

ws3.Rows(1).Delete 'My cheep fix is to delete row 1, which is blank, to get the data to start on row 1.

End Sub

Answer 1

只要想知道我是如何解决我的问题的。

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim r As Integer

Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("Sheet2")
Set ws3 = ThisWorkbook.Sheets("Sheet3")


Dim lRow1 As Long, lRow2 As Long, i As Long, j As Long

lRow1 = ThisWorkbook.Sheets("Sheet2").Range("K" & Rows.Count).End(xlUp).Row
lRow2 = ThisWorkbook.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

r = 1

For i = 1 To lRow1
    For j = 1 To lRow2
        If ws2.Cells(i, 11).Value = ws1.Cells(j, 1).Value Then
            ws2.Cells(i, 11).Resize(, 5).Copy Destination:=ws3.Cells(r, 1)

        r = r + 1

        End If
    Next j
Next i

如果值在不同的工作表中匹配，则循环复制范围到新的空白工作表。

1 个答案: