簡體   English   中英

我正在嘗試將列從一個工作簿復制到具有固定標題的母版

[英]I am trying to copy columns from one workbook to a master with fixed headings

好的,我想我已經閱讀了出現的每個選項,但還沒有從已經回答的選項中得到答案-如果已經回答了,請原諒我,我很特別。

我要做什么是以下幾點:

從具有固定(62)標題的主工作簿中,可以運行Macro / VBA,這將使我能夠打開文件(.csv),從該文件中獲取列並將其放在主表的相應標題下。

.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

我正在努力的按列查找部分...

尼克,我采取了一些不同的方法來解決您面臨的問題。 但是,我認為這將是一種更清潔的方法,並且更容易理解。

此代碼假定您已經打開了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

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM