Question

VB新手，有点迷失......

我有一张有两张纸的工作簿。我需要比较每张纸上的col A. 如果Sheet1 Col A中的计算机名称在Sheet2 A：A上找到匹配，则宏将在sheet2中添加一行，然后从Sheet1 cols A，B添加数据，然后从Sheet1中删除数据。

Sheet 1中
       A      |    B
| EVW7LT206152 |拥抱，阿曼
  | WNW7LN000000 | IMPO，MrsUn
  | EVW7LT205803 | DOE，简
  | EVW7LN205817 | Doe，John


Sheet 2中
      A          B             C          D
| EVW7LN205817 | Doe，John | 12/20/2014 | 191.000.43.170
  | EVW7LT206152 |拥抱，阿曼| 12/20/2014 | 191.000.43.10
  | NYW7LN000000 | IMPO，MrUn | 12/20/2014 | 191.000.43.197
  | EVW7LT205803 | Doe，Jane | 12/20/2014 | 191.000.43.145


Sheet1（已完成）
     A         |      B
WNW7LN000000 | IMPO，MrsUn


Sheet2（已完成）
      A          B             C          D
| EVW7LN205817 | Doe，John | 12/20/2014 | 191.000.43.170
| EVW7LN205817 | Doe，John | |

| NYW7LN000000 | Impo，MrUn | 12/20/2014 | 191.000.43.197

这很接近，但不像我的例子那样从表1中进行del匹配。

Function DoOne(RowIndex As Integer) As Boolean
    Dim Key
    Dim Target
    Dim Success
    Success = False
    If Not IsEmpty(Cells(RowIndex, 1).Value) Then
        Key = Cells(RowIndex, 1).Value

        Sheets("Sheet1").Select

        Set Target = Columns(1).Find(Key, LookIn:=xlValues)

        If Not Target Is Nothing Then
            Rows(Target.Row).Select
            Selection.Copy
            Sheets("Sheet2").Select
            Rows(RowIndex + 1).Select
            Selection.Insert Shift:=xlDown
            Rows(RowIndex + 2).Select
            Application.CutCopyMode = True
            Selection.Insert Shift:=xlDown, copyOrigin:=xlFormatFromLeftOrAbove
            Cells(RowIndex + 3, 1).Select
            Success = True
        End If

    End If
    DoOne = Success
End Function

-

Sub TheMacro()
    Dim RowIndex As Integer
    Sheets("Sheet2").Select
    RowIndex = Cells.Row
    While DoOne(RowIndex)
        RowIndex = RowIndex + 3
    Wend
End Sub

Answer 1

首先，您应该始终避免使用here所述的Select和Selection。此外，在切换工作表时，您需要在使用Cells，Rows等时参考工作表。

您的基本代码将起作用，您只需添加一行来删除Sheet1中的行：

Function DoOne(RowIndex As Integer) As Boolean
    Dim Key
    Dim Target
    Dim Success
    Success = False
    If Not IsEmpty(Sheets("Sheet2").Cells(RowIndex, 1).Value) Then
        Key = Sheets("Sheet2").Cells(RowIndex, 1).Value

        Set Target = Sheets("Sheet1").Columns(1).Find(Key, LookIn:=xlValues)

        If Not Target Is Nothing Then
            Sheets("Sheet1").Rows(Target.Row).Copy
            Sheets("Sheet2").Rows(RowIndex + 1).Insert Shift:=xlDown
            Sheets("Sheet2").Rows(RowIndex + 2).Insert Shift:=xlDown, copyOrigin:=xlFormatFromLeftOrAbove
            Sheets("Sheet1").Rows(Target.Row).Delete
            Success = True
        End If

    End If
    DoOne = Success
End Function

你的潜艇基本上保持不变。只需删除使用Select的行并添加工作表参考，然后关闭屏幕更新即可加快速度：

Sub TheMacro()
    Application.ScreenUpdating = False
    Dim RowIndex As Integer

    RowIndex = Sheets("Sheet2").Cells.Row
    While DoOne(RowIndex)
        RowIndex = RowIndex + 3
    Wend
    Application.ScreenUpdating = True
End Sub

从Sheet1找到Sheet2上的匹配 - 从Sheet1切换匹配到Sheet2

1 个答案: