查找匹配，從Sheet1複製行並插入Sheet2

在Sheet1中，我有大約10,000行代表不同的人。每個人都有一個位於列D中的唯一ID，這是一個以文本形式存儲的數字序列。查找匹配，從Sheet1複製行並插入Sheet2

在工作表2中，我有大約1,200個人員條目，它們具有對Sheet1中位於列A中的匹配人員的引用。此引用是Sheet1中使用的相同唯一ID。

我想什麼是有一個宏做的是這樣的：

讀入單元格A1在Sheet2上
發現在Sheet1中列d匹配值
複製在Sheet
下方插入匹配的行Sheet 2上匹配的行（行2）
插入空白行（第3行）
重複用於在Sheet2上的其餘9999個項的步驟，以便匹配的數據總是落在讀入值下方，其次是一個空白行

任何幫助，將不勝感激。

來源

2011-01-26 anticedent

我可以告訴你，將來你會顯示試圖解決你遇到的問題的證據。這樣我們就知道你參與了社區，而不是試圖從中提取免費的勞動力。

以下是您可以嘗試的解決方案。它從sheet2中當前選定的單元格開始。

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(4).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 = False 
      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

來源

2011-01-26 16:54:35

@ Kevin：首先，感謝您的時間和幫助 - 宏的表現完全符合我的期望。其次，我很抱歉沒有包括我最初的努力。我不是想回避社區的努力，而是學習正確的技巧和不同的解決問題的方法。再次發帖時，我一定會記住您的建議。再次，非常感謝。 – anticedent

@anticedent：很高興能幫到你。 –

查找匹配，從Sheet1複製行並插入Sheet2

回答

相關問題