Board logo

標題: 如何將下面的程式碼改成只匯在同一個資料表 [打印本頁]
作者: qwern    時間: 2012-7-8 03:16     標題: 如何將下面的程式碼改成只匯在同一個資料表

本帖最後由 qwern 於 2012-7-8 10:01 編輯

主要要做的內容是，約有2000多的相同格式的excel檔案，要匯入同一個excel裡面，
但是又不想要他每次匯入時都分別匯入成一個新的資料表，
想要他重上一個貼點的最下面繼續將下將一個資料往下貼下去。
之前有有看過另外一個是貼進來為 不同分頁的，但是我怎麼改他都無法只單純在一個分頁裡面，所以想要請問這個問題。

以下附件為合併巨集跟要匯入的資料 但不知道怎麼把那個合併的巨集改成只匯入成一個工作表，匯入後，他還是會看有幾個檔案就分成幾個工作表
而且還有一個小疑問每個檔案內資料的比數不同，他會不會少抓到之類的?


javascript:;
作者: chen_cook    時間: 2012-7-8 04:54

回復 1# qwern


    這裏是一般區,為什何大家都不依版大的規定呢??:@
作者: qwern    時間: 2012-7-8 10:01

回復 2# chen_cook


    抱歉...已修改，這樣應該可以了
作者: qwern    時間: 2012-7-9 00:02

上面的檔案是合併後會分成很多個分頁，我希望他可以不要分開
作者: hugh0620    時間: 2012-7-9 17:30

本帖最後由 hugh0620 於 2012-7-9 17:31 編輯

回復 4# qwern

  試試下面的寫法~ 依你上載的資料還撰寫~ 將資料夾中的EXCEL檔匯在同一個sheet中~
  A3="檔案名稱"
  B3=欄位A
  A3&B3是要有欄位名稱唷
  1. Application.Calculation = xlCalculationManual
  2. Dim Ar()
  3. With Application.FileDialog(msoFileDialogFolderPicker)
  4.     If .Show = 0 Then Exit Sub  ' 若是沒有選取資料夾路徑，就跳出程序
  5.     Sheet1.Rows("4:1048576").ClearContents
  6.     fd = .SelectedItems(1)
  7.     If .ButtonName = "確定" Then
  8.     fs = Dir(fd & "\*.xls")
  9.         Do Until fs = ""
  10.         fds = fd & "\" & fs
  11.             With Workbooks.Open(fds)
  12.                  A = .Sheets(1).Range("A65536").End(xlUp).Row
  13.                  BN = .Sheets(1).Name
  14.                  .Sheets(1).Range("A1:CW" & A).Copy Sheet1.Range("B1048576").End(xlUp).Offset(1, 0)
  15.                  .Close 0
  16.             End With
  17.             C1 = Sheet1.Range("A1048576").End(xlUp).Offset(1, 0).Row
  18.             C2 = Sheet1.Range("B1048576").End(xlUp).Row
  19.             Sheet1.Range("A" & C1 & ":A" & C2) = BN
  20.             fs = Dir
  21.         Loop
  22.     End If
  23. End With
  24. Application.Calculation = xlCalculationAutomatic
複製代碼
作者: Hsieh    時間: 2012-7-9 17:43

回復 4# qwern
檔案都放在同一個資料夾內
  1. Sub ex()
  2. fs = Dir(ThisWorkbook.Path & "\*.xls*")
  3. Do Until fs = ""
  4. If fs <> ThisWorkbook.Name Then
  5.   With Workbooks.Open(ThisWorkbook.Path & "\" & fs)
  6.      .Sheets(1).UsedRange.Copy ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1)
  7.   .Close 0
  8.   End With
  9. End If
  10. fs = Dir
  11. Loop
  12. End Sub
複製代碼
作者: qwern    時間: 2012-7-10 00:16

Hsieh 超級版主 感謝，好像成功了
VBA向前衝 感謝  這方法我還在測試中
作者: hugh0620    時間: 2012-7-10 09:23

回復 7# qwern


    Hsieh 大大的寫法是直接將資料夾中所有的excel資料匯在一起~
    我的寫法也是之前各大大教的~ 所以看起來不會差異太大~
    在匯整資料時~ 是幫你考量到~ 將每一個檔案匯入時~ 添加上個檔案的名稱~
    這樣會方便使用者在資料有疑問時~ 能夠比較快速找個是哪一個檔案的資料~ 哪邊發生問題
   
    當然~ 這也是要看你自己的需求~ 是不是有需要~
     利用 Hsieh 大大的模式可延伸自己需要的結果~
作者: qwern    時間: 2012-7-15 02:16

恩恩  我發現Hsieh大大的方法在填入第517個excel檔時會有問題，他說複製格式不同是否要貼上



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)