Excel VBA - 使用If-Statement验证的逐行复制

时间:2017-12-20 19:09:50

标签: excel vba if-statement copy rows

我对VBA比较陌生,并且发现自己处于一个角落里。

目标: 我想只在两行之间的特定字段匹配时才将行值从一个电子表格复制到另一个电子表格。如果特定字段不匹配,我需要在复制的 TO 工作簿上跳过一行,然后重新检查复制的 FROM 工作簿,创建一个间隙,直到它们匹配再次。

EX:让复制的 TO 工作簿= WB_A 让复制的 FROM 工作簿= WB_B

两个工作簿都有一个ID#,X坐标和Y坐标

的列

WB_A有一组静态的ID#,范围从-99到632,伴随着X& Y坐标。 WB_B有一组动态的ID#,它也在-99到632范围内但可能在数据中有间隙(149-161可能完全缺失,因此计数为147,148,162,163 ......)。

我想仅在ID#在给定行上匹配时才将值从WB_B复制到WB_A,否则我想在WB_A上留一个间隙,直到它与WB_B匹配为止。

我的方法:

Private Sub rowCount()

Dim mstRows As Long
Dim wsMstr As Worksheet, wsPline As Worksheet
Dim wbCompRes As Workbook, wbPline As Workbook
Dim i       As Integer
Dim rowCounter As Integer

'Find end of Master Worksheet rows
Set wsMstr = ThisWorkbook.Worksheets("Master Wkst")
wsMstr.Activate
mstRows = Worksheets("Master Wkst").Cells(Rows.Count, 1).End(xlUp).Row

'If statment to check if column a1 in Master Wkst = Column b2 in pline file
'If true, copies rows into Master Wkst, If false, skips row
rowCounter = 2
Application.ScreenUpdating = False
For i = 4 To mstRows
    If wsMstr.Cells(i, 1).Value <> Workbooks("20170210_intersect_pline_transect_singlept.dbf") _
       .Worksheets(1).Cells(rowCounter, 2) Then
    Else
        Workbooks("20170210_intersect_pline_transect_singlept.dbf").Activate
        Worksheets(1).Range(Cells(rowCounter, 4), Cells(rowCounter, 5)).Copy
        wsMstr.Activate
        wsMstr.Cells(i, 6).Select
        ActiveSheet.Paste
        rowCounter = rowCounter + 1
    End If
Next
Application.ScreenUpdating = True
End Sub

目前,我有代码,以便它跳过数据中的第一个间隙,然后填写,直到它达到第二个差距。我的麻烦在于循环通过WB_A的不匹配行,同时将WB_B保持在同一行,直到它可以与WB_A匹配。

现在,我将rowCount = 4作为静态字段,我知道这将是需要更改的内容,但我不确定如何更改它以使代码按预期运行。

我已经包含了Pertinent Excel文件的链接 注意:WB_A = Computation_results2017 WB_B = 20170210_Pline ....

Computation_results2017

20170210_Pline...

此外,欢迎任何可能使我的代码更简洁的其他技巧!

感谢您的帮助。

0 个答案:

没有答案