☰

別々のシートにある2つの列を1つの列に結合する

tag-icon • tag-icon microsoft-excel worksheet-function vba
別々のシートにある2つの列を1つの列に結合する

2 つのリストが 2 つの別々のシートにあり、それらを 3 番目のシートに結合しようとしています。これらのリストはユーザーの入力に基づいて自動的に入力されるため、リスト内の行数は異なる場合があります。したがって、シート 1 の最初の列に何も検出されない場合は、次のように、シート 2 の列を使用してシート 3 のリストを入力し始めます。

シート1

Make    Model     License Plate
Ford    Escape    UVC345
Honda   Civic     KD2YR9

シート2

Make    Model    License Plate 
Dodge   Charger  34TRLS2
VW      Passat   V70YTR

シート3

Make    Model    License Plate
Ford    Escape   UVC345
Honda   Civic    KD2YR9
Dodge   Charger  34TRLS2
VW      Passat   V70YTR

アップデート：

VBA を使用してコピー アンド ペーストするときに発生する問題は、シート 1 の最初のリストを自動入力するために使用される数式を貼り付けて識別することです。数式を貼り付けているため、シート 3 の最後のセルがどこにあるかが正しく識別されません。

Sub Copy_Alternatives()

Worksheets("CNA eTool Alternatives").Range("A:A").Copy
Worksheets("Repair Replacement Recom").Range("A:A").PasteSpecial xlPasteValues
Worksheets("CNA eTool Alternatives").Range("B:B").Copy
Worksheets("Repair Replacement Recom").Range("B:B").PasteSpecial xlPasteValues
Worksheets("CNA eTool Alternatives").Range("C:C").Copy
Worksheets("Repair Replacement Recom").Range("C:C").PasteSpecial xlPasteValues

End Sub

Sub Copy_Paste_Range()

Dim lNewRow As Long
Dim lDataRow As Long

ThisWorkbook.Activate

lNewRow = Worksheets("CNA eTool Addit. Alternatives").Cells(Worksheets("CNA eTool Addit. Alternatives").Rows.Count, "H").End(xlUp).Row

lDataRow = Worksheets("Repair Replacement Recom").Cells(Worksheets("Repair Replacement Recom").Rows.Count, 1).End(xlUp).Row
lDataRow = lDataRow + 1

Worksheets("CNA eTool Addit. Alternatives").Range("H2:J" & lNewRow).Copy
Worksheets("Repair Replacement Recom").Range("A" & lDataRow).PasteSpecial

End Sub

答え1

ワークシート関数で作成できます。

最初のシートがでSheet1、2番目のシートがだとしますExtra1

次の数式を A2 の結合シートに入力し、コピーして他のセルに貼り付けます。

=IF(ROW()>COUNTA(Sheet1!A:A)+COUNTA(Extra1!A:A)-1,"",INDIRECT(IF(ROW()<=COUNTA(Sheet1!A:A),"Sheet1!","Extra1!")&SUBSTITUTE(ADDRESS(1,COLUMN(),4),1,"")&ROW()-IF(ROW()<=COUNTA(Sheet1!A:A),0,COUNTA(Sheet1!A:A)-1)))

仕組み:

  1. 現在の行が、最初のシートの行数 + 2 番目のシートの行数から 1 を引いた数より大きいかどうかを確認します (両方にヘッダーがあるため)。
  2. 現在の行の方が大きい場合は、空を表示します。それ以外の場合は、次のステップに進みます。
  3. を準備しますINDIRECT。現在の行が最初のシートの行より低い場合は、最初のシート名を取得します。そうでない場合は、2 番目のシート名を取得します。
  4. 列の現在の文字を返すトリックを使用しますSUBSTITUTE + ADDRESS。これは、すべてのフィールドで同じ式を使用し、列がAAになった場合でも受け入れるので便利です。
  5. 最後に、現在の行が最初のシートの項目数より少ない場合は現在の行を取得し、そうでない場合は、現在の行から最初のシートの行数から 1 を引いた値を取得して、シート 2 の開始行を返します。

ちょっと大変で読みにくいとは思いますが、数式は VBA よりも優れている場合があります。

編集: まあ、ひらめきを得て、動作するVBAバージョンを手に入れました

Sub merge()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Set ws1 = Sheets("Sheet1") 'First sheet to get merged
Set ws2 = Sheets("Extra1") 'Second sheet to get merged
Set ws3 = Sheets("Merged") 'Name of the sheet you want results
Dim lr As Long 'To return the number of the last row
Dim arrayone As Variant
lr = ws1.Cells(Rows.Count, 1).End(xlUp).Row
arrayone = Range(ws1.Cells(2, 1), ws1.Cells(lr, 3)).Value 'From Row 2 onwards, considering it has headers
Dim arr2 As Variant
lr = ws2.Cells(Rows.Count, 1).End(xlUp).Row
arr2 = Range(ws2.Cells(2, 1), ws2.Cells(lr, 3)).Value 'From Row 2 onwards, considering it has headers
Dim arr3 As Variant
ReDim arr3(1 To UBound(arrayone, 1) + UBound(arr2, 1), 1 To 3)
For i = 1 To UBound(arr3, 1)
    For j = 1 To 3
        If i <= UBound(arrayone, 1) Then
            arr3(i, j) = arrayone(i, j)
        Else
            arr3(i, j) = arr2(i - UBound(arrayone, 1), j)
        End If
    Next j
Next i
Range(ws3.Cells(2, 1), ws3.Cells(UBound(arr3) + 1, 3)).Value = arr3
End Sub

関連情報