一致を見つけ、Sheet1から行をコピーしてSheet2に挿入

Question

Sheet1には、約10,000行が異なる人物を表しています。各人は、列DにあるユニークなIDを持っています。これは、テキストとして格納された数字シーケンスです。

Sheet2には、A列にあるSheet1の一致する人物への参照を持つ約1,200人のエントリーがあります。この参照は、Sheet1で使用されている同じ一意のIDです。私が望む何

は、マクロを持ってすることですこれです：

• 読み込みにセルA1の値Sheet2の
に
• をシート1
のカラムDに一致する値を見つける
• コピーシート2上に下に一致する行を挿入
• シート1
の行に一致（行2）

• 空白行を挿入する（行3）

空白行

任意の助けが続くようにシート2の残りの9,999エントリのステップは、一致するデータが常に読み取りの値の下に低下

リピートは、理解されるであろう。

Answer 1

今後、問題が解決したことを示す証拠を提示することをお勧めします。そうすれば、あなたはあなたが地域社会に参加しており、そこから自由労働を取り出そうとしていないことが分かります。

これはあなたが試すことができる解決策です。シート2の現在選択されているセルから開始します。

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