VBA選取多檔案篩選後複製至新檔案並另存

excel vba

epoch5220 2021-04-18 11:04:17 ‧ 1968 瀏覽

分享至

想請問各位大神QAQ
目前我有多檔案要在vba開啟後，將每個檔案篩選，並另存至一新檔案
而每個檔案資料要接續上個檔案的資料

目前我有幾段程式但實在是不知道要如何將他們整合
下面是將多檔開啟的程式，
但我有點不理解 fname = y(UBound(y))的意思

x = Application.GetOpenFilename(MultiSelect:=True) '輸入多檔
   For i = LBound(x) To UBound(x)
     Workbooks.Open Filename:=x(i), ReadOnly:=True
     y = Split(x(i), "\")
     fname = y(UBound(y))
     Workbooks(fname).Close savechanges:=False

下段是開啟單一檔之後篩選另存的程式
我知道要利用迴圈，但實在是沒甚麼頭緒，
希望大家可以幫忙一下
謝謝TAT

Sub filetest()
  X = Application.GetOpenFilename()
  Workbooks.OpenText Filename:=X, DataType:=xlDelimited, Comma:=True
  y = Split(X, "\")
  fname = y(UBound(y))
  Workbooks(fname).Worksheets(1).Range("A1").AutoFilter Field:=5, 	Criteria1:="住宿及餐飲業"
   Workbooks(fname).Worksheets(1).Range("A1").AutoFilter Field:=3, 	Criteria1:=“>25"
   n = Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Areas.Count
   k = 1
   For i = 1 To n
     Workbooks(fname).Worksheets(1).Range("A1").CurrentRegion.SpecialCells      	(xlCellTypeVisible).Areas(i).Copy Destination:=ThisWorkbook. 	Worksheets(1).Cells(k, 1)
      k = k + Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible). 	Areas(i).Rows.Count
   Next i
   Workbooks(fname).Close savechanges:=False
   ThisWorkbook.SaveAs Filename:="住宿及餐飲業.csv", FileFormat:=xlCSV
   ThisWorkbook.Close savechanges:=False
End Sub

登入發表討論

直播研討會

{{ item.channelVendor }} {{ item.webinarstarted }} |

直播中

1 個回答

海綿寶寶

iT邦大神 1 級 ‧ 2021-04-18 14:36:58

最佳解答

Workbooks.Open Filename:=x(i), ReadOnly:=True  'x(i)="C:\Documents\path\a101.xls"
y = Split(x(i), "\")  'y = ["C:","Documents","path","a101.xls"]
fname = y(UBound(y))  'UBound(y) 是陣列y最後一個索引值, 所以 y(UBound(y)) = "a101.xls"

回應 1
分享
檢舉

epoch5220 iT邦新手 5 級 ‧ 2021-04-19 11:42:42 檢舉

謝謝您，我已看懂上面的程式碼，
目前我開單一檔時和多檔會產生新檔案且有內容，
但內容錯誤，且多檔時好像只跑出一檔的東西
可以請您幫我看一下程式碼嗎
謝謝您QAQ

Sub test()
x = Application.GetOpenFilename(MultiSelect:=True) '輸入多檔
   For i = LBound(x) To UBound(x)
     Workbooks.Open Filename:=x(i), ReadOnly:=True
     y = Split(x(i), "\")
     fname = y(UBound(y))
     
     '\\\
     
     Workbooks(fname).Worksheets(1).Range("A1").AutoFilter Field:=5, Criteria1:="住宿及餐飲業"
   Workbooks(fname).Worksheets(1).Range("A1").AutoFilter Field:=3, Criteria1:=">25"
   n = Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Areas.Count
   k = Workbooks(fname).Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
   'dat_len = Workbooks(fname).Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
   For j = 1 To n
   
           Workbooks(fname).Worksheets(1).Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Areas(i).Copy Destination:=ThisWorkbook.Worksheets(1).Cells(k, 1)
      k = k + Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Areas(i).Rows.Count'目前最後row數

   Next j
 
   ThisWorkbook.SaveAs Filename:="住宿及餐飲業.csv", FileFormat:=xlCSV
     
     Workbooks(fname).Close savechanges:=False
     Next i
End Sub

登入發表回應