Sheet 2上的工作表Sheet1从查找匹配 - 从工作表Sheet1切匹配到Sheet2

Question

新建VB和有点失落......

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

工作表Sheet1

 A  | B 

| EVW7LT206152 | Hug，Aman
| WNW7LN000000 | Impo，MrsUn
| EVW7LT205803 | Doe，Jane
| EVW7LN205817 |母鹿，约翰

---

Sheet2中

 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 | |

| EVW7LT206152 |拥抱，阿曼| | 191.000.43.10
| EVW7LT206152 |拥抱，阿曼| |

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

| EVW7LT205803 | Doe，Jane | | 191.000.43.145
| EVW7LT205803 | Doe，Jane | |

---

这是接近，但不会从工作表1删除匹配，就像我的例子。

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

首先，你应该总是避免使用Select和Selection描述here。另外，在纸张之间切换时，使用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