0

Excelに4列の小さなデータセットがあります

File A: 

  SNO   TYPE  CountryA   CountryB   CountryD
    1    T1    A1          B2         D1          
    2    T2    A2          B2         D2

そして、私はこのデータを別のExcelファイルに持っています

File B:

   SNO   TYPE  CountryB  CountryA CountryC
    11    T10   B10         A10     C10
    22    T20   B20         A20     C20
    33    T30   B30         A30     C30

ファイルAのデータの上にファイルBのデータを貼り付けたい場合は、vbaコードを使用して列名を自動的に整列させます。

したがって、最終結果は次のようになります。

       SNO  TYPE CountryA    CountryB  CountryC  CountryD           
        1    T1   A1           B1         --         D1
        2    T2   A2           B2         --         D2 
        11   T10  A10          B10        C10        --
        22   T20  A20          B20        C20        --
        33   T30  A30          B30        C30        --
4

2 に答える 2

2

これはあなたのために働くはずです：

Sub MatchUpColumnDataBasedOnHeaders()

Dim wbk As Workbook
Set wbk = ThisWorkbook
Set ws = wbk.Sheets(1)
Set ws2 = wbk.Sheets(2)
Dim cell As Range
Dim refcell As Range

Application.ScreenUpdating = False
ws.Select

    For Each cell In ws.Range("A1:Z1")

        cell.Activate
        ActiveCell.EntireColumn.Copy

        For Each refcell In ws2.Range("A1:Z1")
            If refcell.Value = cell.Value Then refcell.PasteSpecial (xlPasteValues)
        Next refcell

    Next cell
Application.ScreenUpdating = True

End Sub

おかしいです、私はこれを行うための本当に簡単な非VBAの方法があると感じています-しかし私はグーグルでそれのためのボタンを見つけることができませんでした。これは、シート1と2の列AからZで機能します。これは、ヘッダーが行1にあることを前提としています。

編集-追加：

あなたがファイルでこれをやりたいと思っていて、シートについて何も言わなかったことに気づきました。これは、さまざまなワークブックでそれを行う方法です。

Sub MatchUpColumnDataBasedOnHeadersInFiles()

Dim wbk As Workbook

Set wbk = ThisWorkbook

Workbooks.Open Filename:="C:\PasteIntoWorkbook.xlsx"
Set wbk2 = Workbooks("PasteIntoWorkbook.xlsx")

Set ws = wbk.Sheets(1)
Set ws2 = wbk2.Sheets(1)

Dim cell As Range
Dim refcell As Range

wbk.Activate

Application.ScreenUpdating = False

ws.Select

    For Each cell In ws.Range("A1:N1")

        wbk.Activate
        ws.Select

        cell.Activate
        ActiveCell.EntireColumn.Copy

        wbk2.Activate
        ws2.Select

        For Each refcell In ws2.Range("A1:N1")
            If refcell.Value = cell.Value Then refcell.PasteSpecial (xlPasteValues)
        Next refcell

    Next cell

ws2.Select
Range("A1").Select
wbk.Activate
ws.Select
Range("A1").Select

Application.ScreenUpdating = True

End Sub

したがって、さまざまな.xlsファイルを操作することに心を決めていれば、それがあなたのやり方です。明らかに、ファイルのパスをファイルへの貼り付けに合わせて調整する必要があります。

于 2012-08-09T21:04:39.797 に答える
0

一致する列のコーディング

Sheet2 = 元の HEADERS (必要なヘッダーのみ - 行 1 に入れます)

Sheet1 =ヘッダーと一緒のデータですが、ヘッダーが同期されていないため、ヘッダーが多かったり少なかったりする可能性がありますが、シート2にある見出しに従ってデータが必要です

sheet2 に既に存在するヘッダーの下の sheet2 (行 2 ) にデータを配置し、以下のコーディングを実行すると、必要なヘッダーに従ってデータが表示されます。

Sub Rahul()


Dim Orig_Range As Range
Dim New_Range As Range
Dim ToMove As Range
Dim RowOld, RowNew As Long
Dim ColOld, ColNew As Long
Dim WSD As Worksheet
Dim Cname As String

Set WSD = ActiveSheet

ColOld = WSD.Cells(1, Application.Columns.Count).End(xlToLeft).Column

ColNew = WSD.Cells(2, Application.Columns.Count).End(xlToLeft).Column

RowNew = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row

RowOld = 1


Set Orig_Range = Range(WSD.Cells(1, 1), WSD.Cells(1, ColOld))



For i = 1 To ColOld

Set New_Range = Range(WSD.Cells(2, 1), WSD.Cells(2, ColNew))


Cname = Orig_Range.Cells(RowOld, i).Value

Set ToMove = New_Range.Find(what:=Cname, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, MatchCase:=True)


If ToMove Is Nothing Then

New_Range.Cells(1, i).Resize(RowNew, 1).Select

Selection.Insert shift:=xlToRight




ElseIf Not ToMove.Column = i Then

ToMove.Resize(RowNew, 1).Select




Selection.Cut

New_Range.Cells(1, i).Select

Selection.Insert shift:=xlToRight

End If

Next i


End Sub
于 2016-04-17T03:56:32.790 に答える