返回列表 上一主題 發帖

如何將下面的程式碼改成只匯在同一個資料表

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
559 
主題
58 
精華
0 
積分
626 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-6-14 
1# 跳轉到 »
發表於 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
複製代碼
學習才能提升自己

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
559 
主題
58 
精華
0 
積分
626 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-6-14 
2#
發表於 2012-7-10 09:23 | 顯示全部帖子
回復 7# qwern


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

TOP

        靜思自在 : 有願放在心裡，沒有身體力行，正如耕田不播種，皆是空過因緣。
返回列表 上一主題