1

OK、私は出てくるすべてのオプションを読んだと思いますが、すでに回答されているものからの回答は得られていません.

私がやろうとしていることは次のとおりです。

固定 (62) 見出しを持つマスター WorkBook から、ファイル (.csv) を開くことができるマクロ/VBA を実行できます。このファイルから列を取得し、マスター シートのそれぞれのヘッダーの下に配置します。

.csv ファイルには、メイン ファイルと一致する列ヘッダーが確実に含まれますが、同じ順序ではない場合があります。

どうぞよろしくお願いいたします。

ニック

これは私がこれまで助けてきたコードです...

Sub CopyCSV()

'' Find out how many rows are on the CSV sheet
LRCSV = Sheet1.UsedRange.Rows.Count

'' Find out how many columns are on the Data sheet
LCData = Sheet2.UsedRange.Columns.Count

For x = 2 To LRCSV

'' Find the last row and add one to get the first blank row
LRData = Sheet2.UsedRange.Rows.Count + 1

Sheet2.Activate

'' Finds the columns by the headers

If FirstN = "" Then
    For y = 1 To LCData
        If Cells(1, y).Value = "First Name" Then FirstN = y
        If Cells(1, y).Value = "Surname" Then SurN = y
        If Cells(1, y).Value = "Email" Then Email = y
        If Cells(1, y).Value = "Telephone Number" Then TelN = y
    Next y
End If

Sheet1.Activate

Sheet2.Cells(LRData, FirstN).Value = Sheet1.Cells(x, "A").Value
Sheet2.Cells(LRData, SurN).Value = Sheet1.Cells(x, "B").Value
Sheet2.Cells(LRData, Email).Value = Sheet1.Cells(x, "C").Value
Sheet2.Cells(LRData, TelN).Value = Sheet1.Cells(x, "D").Value

Next x

End Sub

私が苦労している列セクションによる検索...

4

1 に答える 1

1

ニック、あなたが直面している問題を解決するために、私は少し異なるアプローチを取りました。しかし、よりクリーンでわかりやすいアプローチになると思います。

このコードは、CSV が既に開いていることを前提としています。また、オブジェクト用に入力した多くのプレースホルダーがあります。ニーズに合わせて変更してください。また、コードをより完全に理解するのに役立つと思われる箇所に少しコメントしました。

Option Explicit

Sub CopyColumns()

'set the variables needed
Dim wkbMain As Workbook, wkbCopy As Workbook
Dim wksMain As Worksheet, wksCopy As Worksheet

Set wkbMain = Workbooks("Master.xlsm")
Set wkbCopy = Workbooks("email - pws a.csv")

Set wksMain = wkbMain.Sheets("Master")
Set wksCopy = wkbCopy.Sheets(1) 'csv files will only ever have 1 sheet

With wksMain

    'capture the header row in the master sheet
    Dim rngFind As Range, cel As Range
    Set rngFind = Intersect(.UsedRange, .Rows(1)) 'assumes contigous header rows
    'Set rngFind = .Range(.Range("A1"),.Range("A" & .Columns.Count).End(xlToRight) ' could use this as well if your data starts in cell A1

    For Each cel In rngFind 'loop through each header in the row

      Dim rngCopy As Range

      With wksCopy

        Set rngCopy = .Rows(1).Find(cel, after:=.Cells(1, .Columns.Count), lookat:=xlPart, LookIn:=xlValues) 'find the header name in the CSV sheet
        'now copy the entire column (minus the header row)
        Set rngCopy = .Range(rngCopy.Offset(1), .Cells(.Rows.Count, rngCopy.Column).End(xlUp))
        rngCopy.Copy Destination:=wksMain.Cells(2, cel.Column) 'paste it to the matching header in the main sheet

      End With

    Next

End With 'this was missing

End Sub
于 2013-01-07T15:19:24.067 に答える