SDMan
Lv 4
SDMan asked in 電腦與網際網路軟體 · 1 decade ago

excel 多個檔案的一欄複製到一個sheet裡

假設有..100筆檔案 *.csv

想要將其中的 F整欄的值 通通copy 到一個檔.csv 的sheet1裡

這樣該如何做呢^^?

Update:

不好意思兩個回答小弟原本就會了^^" 不過小弟想要的答案比較偏向使用巨集 重新敘述好了: 有100個 excel 檔案

然後想把這100 excel 檔的sheet1 的F欄 通通copy 到一巨集指定的檔案例如 marco.csv

因為實際際檔案數遠大於100個 因此只能靠巨集自動將某個資料夾裡的excel檔案上千個做此上面的動作

沒辦法土法煉鋼^^ 因為太花時間了希望能有高手能幫忙 指引macro 的寫法..謝謝~

3 Answers

Rating
  • 1 decade ago
    Best Answer

    來吧...由於寫法有點小複雜 上沒有確切的的*.CSV欄位數

    所以直接把程式碼給你

    COPY上執行即可

    注意事項:

    1.這是把你要的[*.CSV的第6欄]逐筆[橫向]貼上

    所以最大筆數不能超過256筆

    2.如果有確切的[*.CSV]欄位數

    能加快執行但是程式碼要重修改

    3.由於等級太低所以只好分開貼...

    '-------------------------------------------程式開頭

    '定義廣域變數

    Public FileName, NewSheetName

    '--------------------------

    '主程序

    Sub 選取檔案()

    '關閉畫面更新

    Application.ScreenUpdating = False

    '關閉系統警告訊息

    Application.DisplayAlerts = False

    '建立新標籤(Sheet)

    ActiveWorkbook.Worksheets.Add

    '取得新標籤(Sheet)名稱

    NewSheetName = Selection.Worksheet.Name

    '執行對話視窗(選取檔案對話窗)

    With Application.FileDialog(msoFileDialogOpen)

    .AllowMultiSelect = True '可複項選取

    .Show

    If .SelectedItems.Count > 256 Then

    '選取數超出256筆,警示且停止執行

    MsgBox "選取數超出256筆"

    End

    ElseIf .SelectedItems.Count = 0 Then

    '無選取,警示且停止執行

    MsgBox "無選擇資料"

    End

    Else

    For lngCount = 1 To .SelectedItems.Count

    Application.StatusBar = "共" & .SelectedItems.Count & "筆資料處理中-第" & lngCount & "筆" 'Excel左下方顯示進度

    Macro_1 .SelectedItems(lngCount), lngCount, NewSheetName '逐筆載入子程序

    Next lngCount

    End If

    End With

    '還原畫面更新

    Application.ScreenUpdating = ture

    '還原系統警告訊息

    Application.DisplayAlerts = True

    '還原系統注釋

    Application.StatusBar = False

    End Sub

    '--------------------------接子程序

    2008-03-08 11:46:49 補充:

    '子程序

    Sub Macro_1(FileName, lngCount, NewSheetName)

    '定義變數

    Dim ar, WNF

    '拆解檔案全路徑

    ar = Split(FileName, "\")

    '取檔名, 檔名為拆解後做後一組字串

    WNF = ar(UBound(ar))

    2008-03-08 11:47:51 補充:

    '建立來源資料頁

    Sheets.Add.Name = WNF

    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & FileName, Destination:=Sheets(WNF).Range("A1"))

    .Name = WNF

    .FieldNames = True

    .RowNumbers = False

    .FillAdjacentFormulas = False

    2008-03-08 11:48:14 補充:

    .PreserveFormatting = True

    .RefreshOnFileOpen = False

    .RefreshStyle = xlInsertDeleteCells

    .SavePassword = False

    .SaveData = True

    .AdjustColumnWidth = True

    .RefreshPeriod = 0

    .TextFilePromptOnRefresh = False

    .TextFilePlatform = 950

    2008-03-08 11:48:45 補充:

    .TextFileStartRow = 1

    .TextFileParseType = xlDelimited

    .TextFileTextQualifier = xlTextQualifierDoubleQuote

    .TextFileConsecutiveDelimiter = False

    .TextFileTabDelimiter = False

    .TextFileSemicolonDelimiter = False

    2008-03-08 11:49:01 補充:

    .TextFileCommaDelimiter = True

    .TextFileSpaceDelimiter = False

    .TextFileColumnDataTypes = Array(1)

    .TextFileTrailingMinusNumbers = True

    .Refresh BackgroundQuery:=False

    End With

    2008-03-08 11:49:21 補充:

    '將[來源資料]的第6欄(F欄)貼在新標籤(Sheet)的最後一個通白欄

    A = Application.WorksheetFunction.CountA(Sheets(NewSheetName).Rows(1)) + 1

    Sheets(NewSheetName).Columns(A) = Sheets(WNF).Columns(6).Value

    '刪除來源資料

    Sheets(WNF).Delete

    End Sub

    '-------------------------------------------程式結尾

    2008-03-08 12:32:07 補充:

    使用方法

    1.執行[選取檔案]

    2.圈選你要載入的*.CSV

    3.等程式跑完

    4.完成

    2008-03-11 20:06:41 補充:

    '主程序

    Sub 選取檔案()

    DataRange = InputBox("請輸入要載入的資料筆數")

    With Application.FileDialog(msoFileDialogOpen)

    .AllowMultiSelect = True

    .Show

    If .SelectedItems.Count > 256 Then

    MsgBox "選取數超出256筆"

    ElseIf .SelectedItems.Count = 0 Then

    '--接A

    2008-03-11 20:08:35 補充:

    '貼上多連結檔OK嗎?

    '請COPY下列程式碼試試

    '主程序

    Sub 選取檔案()

    DataRange = InputBox("請輸入要載入的資料筆數")

    With Application.FileDialog(msoFileDialogOpen)

    .AllowMultiSelect = True

    .Show

    If .SelectedItems.Count > 256 Then

    MsgBox "選取數超出256筆"

    '接A

    2008-03-11 20:08:43 補充:

    'A

    ElseIf .SelectedItems.Count = 0 Then

    MsgBox "無選擇資料"

    Else

    For lngCount = 1 To .SelectedItems.Count

    Macro_1 .SelectedItems(lngCount), lngCount, DataRange

    Next lngCount

    End If

    End With

    End Sub

    '接B

    2008-03-11 20:08:57 補充:

    'B

    '子程序

    Sub Macro_1(FileName, lngCount, DataRange)

    Dim ar, I&

    ar = Split(FileName, "\")

    ar(UBound(ar)) = "[" & ar(UBound(ar)) & "]"

    FileName = Join(ar, "\")

    I = 1

    For I = 1 To DataRange

    Cells(I, lngCount) = "='" & FileName & "Sheet1'!F" & I

    Next I

    End Sub

    Source(s): 自己多年的煎熬, 自己多年的煎熬, 自己多年的煎熬, 自己多年的煎熬補充
  • 1 decade ago

    你就把原始檔資料(要複製的工作頁)和目的檔(要貼上資料的工作頁)同時都打開來

    然後在原始資料檔某區塊(F1:F100),全部選取來並按複製,(記住要用連續的欄位呀,若不是,則請分段複製和貼上的動作)

    然後在到目的檔,起始處(假設為E10)按貼上,就可以了全部貼上了(也可以選擇滑鼠右鍵去點[選擇性貼上]!

    另外還有一種方法如下:

    即你的原始檔的資料會隨時更改的話,那就可以用儲存公式位址指向法

    此方法和之前方法大同小異,只是反動作回去而已

    也就是在你目的檔的起始欄位上(假設為E10),輸入=號,然後用滑鼠游標去點原始檔工作頁的第一筆資料,然後按enter鍵,即出現第一筆資料!亦即你的目的檔工作頁的E10為原始檔工作頁的某一欄位(F欄)

    然後再將E10選取後,往下複製100筆即可得到你的需求。(但此資料還是得連續的)

    此法的好處是,若你的原始檔的資料有所變動,則你的目的檔資料也會跟著改變,而不用再重複的去複製與貼上的動作。

    當然,它的缺點也就是,你的原始檔因某些格式或欄位增減而改變,你的目的檔可能會因為捉不到被你改變的區塊了,而出現錯誤訊息,我想你應會知道怎麼去克服它吧!

    2008-03-07 15:12:11 補充:

    這是唯一較簡單的方法,除非你的檔案名是有共通點:如A001,A002,A003,............A100

    試試看,有沒有大師可以幫你,但你若要因此改變檔名,是不是也一樣麻煩呢?請慎思!

    2008-03-07 15:28:58 補充:

    當然,你也可以用位址指向法,亦即在你的目的檔上的儲存格去指定來源檔的資料格,然後用複製的,但我想這方法也不見得多快!

  • hank
    Lv 5
    1 decade ago

    =[Book1]Sheet1!$F$1

    [Book1] : 檔案名稱

    Sheet1:工作表名稱

    $F$1 : 第F欄第一格

    依照這個格式設定就可以了!

Still have questions? Get your answers by asking now.