iT邦幫忙

0

vba 資料夾內的檔案,逐一複製到新檔,再另存

各位大大好
小妹為vba小白,用一點點程式基礎+錄製巨集+google,努力了4天還是搞不定
不知道問題在哪,只會跑一次就停了

想達到的:
把資料夾C:\Users\vi\Downloads\原始資料\內每個檔案的A1:E5儲存格資料,貼到篩選表(是固定的,已寫好12個工作表的陣列),再分別以原檔案的名稱另存
C:\Users\vi\Downloads\原始資料\A02.csv →複製A1:E5儲存格 →到篩選表s2~s13的A2貼上 →到C:\Users\vi\Downloads\轉出資料\ 存檔為A02.xls →再重複這個過程

Sub 嘗試()
    Dim mFile As String
    For i = 1 To 200
        mFile = Dir("C:\Users\viva\Downloads\原始資料\*.csv")
    Next i
    
    Do While mFile <> ""
        Workbooks.Open Filename:="C:\Users\viva\Downloads\原始資料\" & mFile
        mFile = Dir()
        Range("A1:E5").Select
        Selection.Copy
        Windows("篩選表.xls").Activate
        Sheets(Array("s2", "s3", "s4", "s5", "s6", "s7", "s8", "s9", "s10", "s11", "s12", _
        "s13")).Select
        Sheets("s2").Activate
        Range("A2").Select
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
        nName = Application.Workbooks(2).Name
        Workbooks("篩選表.xls").SaveAs "C:\Users\viva\Downloads\轉出資料\" & nName & ".xls"
        Workbooks.Close
        Workbooks(2).Close
    Loop
End Sub
skyksl066 iT邦新手 5 級 ‧ 2020-09-22 16:31:24 檢舉
因為目前手邊沒windows電腦沒辦法幫你測試不過,你上面的程式有問題。
```
For i = 1 To 200
mFile = Dir("C:\Users\viva\Downloads\原始資料\*.csv")
Next i
```
這段沒意義跑了200次都一直在覆蓋掉mFile這個變數
```
Do While mFile <> "" 當mFile不等於空白

但是下面mFile = Dir()又把它變空白了
```
改一下因該就會跑了
akissiva iT邦新手 5 級 ‧ 2020-09-22 17:11:10 檢舉
大大您好
我把For迴圈拿掉,Dir的()拿掉,就完全不會跑了......
謝謝

2 個回答

0
skyksl066
iT邦新手 5 級 ‧ 2020-09-22 20:20:38
最佳解答
Sub aaa()
    Dim mFile As String
    mFile = Dir("C:\Users\vi\Downloads\原始資料\*.csv")
    Workbooks.Open Filename:="C:\Users\vi\Downloads\對照.xlsx"
    Do While mFile <> ""
        Debug.Print mFile
            Workbooks.Open Filename:="C:\Users\vi\Downloads\原始資料\" & mFile
            Range("A1:E5").Select
            Selection.Copy
            Workbooks(2).Activate
            Sheets(Array("s2", "s3", "s4", "s5", "s6", "s7", "s8", "s9", "s10", "s11", "s12")).Select
            Sheets("s2").Activate
            Range("A2").Select
            Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
            nName = Application.Workbooks(3).Name
            Workbooks(2).SaveAs "C:\Users\vi\Downloads\轉出資料\" & nName & ".xlsx"
            Workbooks(3).Close

        mFile = Dir
    Loop
    Workbooks(2).Close
End Sub

將“對照.xlsx”檔案那隻關閉這個設定並存檔


滑鼠移到 Excel 視窗上方的功能列,
依序點選【工具(T)】、【選項(O)】、及【安全性】,
在『隱私選項』下面有一個核取方塊寫著『存檔時自檔案摘要資訊中移除個人資訊(R)』,
試著不要打勾,然後點選【確定】。


-2007路徑
檔案/選項/信任中心/信任中心設定/隱私選項/
取消勾選 存檔時自檔案摘要資訊中移除私人資訊


實測可用
思考流路
1.檔案1為vba主程式
檔案2為對照.xlsx
檔案3為x.csv
2.主程式執行
3.取得csv路徑
4.開啟對照.xlsx
5.開啟x.csv
6.do something
7.取得csv名稱
8.另存對照為x.csv.xlsx
9.關閉x.csv
10.回5
11.完成後關閉對照.xlsx

akissiva iT邦新手 5 級 ‧ 2020-09-23 11:00:16 檢舉

sk大
成功了~成功了~~
感動得亂七八糟
當下是摀著嘴、手抖、眼眶泛淚、驚喜交加
真的不敢相信,天阿
好開心阿~~~~~~~~~~~~~
/images/emoticon/emoticon37.gif/images/emoticon/emoticon62.gif/images/emoticon/emoticon24.gif

來快樂地說說測試的細節
『存檔時自檔案摘要資訊中移除個人資訊(R)』原本就是沒打勾的
我想了想sk大所講的邏輯,把vba放一個空的xls當主程式,把要套用的格式放在對照.xls,跑起來速度更快了
好像沒講什麼,原諒小妹我現在整個興奮到升天/images/emoticon/emoticon14.gif/images/emoticon/emoticon58.gif

真的原本以為是for迴圈擺放位置的問題,沒想到壓根問題不在那

感恩大大,讚頌大大,/images/emoticon/emoticon42.gif/images/emoticon/emoticon32.gif/images/emoticon/emoticon41.gif/images/emoticon/emoticon74.gif

繼續來參悟一下思考卡住的地方
太開心了

akissiva iT邦新手 5 級 ‧ 2020-09-25 17:03:20 檢舉

這幾天我把新舊兩隻程式對照著看,試著理清思路,也嘗試改寫
問題就像sk大大說過的:「VBA沒辦法幫自己另存檔再繼續執行」
即使是不關掉它也沒辦法繼續當Workbooks(1)
不知道這是不是VBA本身的限制

想起幾天前就是硬要寫在一張表、鑽進死胡同,感到有點羞/images/emoticon/emoticon25.gif
感想:寫程式,能達到目的,總比寫不出來好,思路要靈活

但對比週一寫到生無可戀的自己,此刻就像重新活過來一樣
再次謝謝兩位大大的指導/images/emoticon/emoticon41.gif

1
海綿寶寶
iT邦大神 1 級 ‧ 2020-09-22 16:44:21

試試看
會不會顯示出所有 csv 檔名
會的話
再把你原來那些 code
填進去

Sub Macro1()
    Dim mFile As String
    
    mFile = Dir("C:\Users\viva\Downloads\原始資料\*.csv")

    Do While mFile <> ""
        Debug.Print mFile
        '=======================
        '要做的事寫在這裡
        '=======================
        mFile = Dir
    Loop
End Sub
看更多先前的回應...收起先前的回應...
akissiva iT邦新手 5 級 ‧ 2020-09-22 17:05:11 檢舉

大大您好
試了一下,沒有顯示任何東西(還是說它應該顯示在哪邊??),看起來xls沒有在動
填入code後,還是只有跑一次

謝謝

應該顯示在下圖下方的位置
(我用 *.jpg 測試,出現 *.jpg 檔名)
如果沒有顯示
就是路徑/檔名不對,或是程式寫錯

https://ithelp.ithome.com.tw/upload/images/20200922/200017871SkLH1HZU0.png

akissiva iT邦新手 5 級 ‧ 2020-09-22 17:39:31 檢舉

大大您好
有的,即時運算視窗叫出來,執行巨集有顯示出所有csv檔名,

把code貼上去後,只有轉了一個檔案出來
https://ithelp.ithome.com.tw/upload/images/20200922/20131031Qo9zcb7ypR.jpg

謝謝

執行巨集有顯示出所有csv檔名

我提供的程式只解決這個問題

剩下的部份
建議你自己按 F8 (逐行執行) 鍵一步一步執行
看看是那一段有問題

skyksl066 iT邦新手 5 級 ‧ 2020-09-22 17:51:49 檢舉

海綿大大的程式沒問題喔,我看了一下是你執行的思考流路有問題

Workbooks("篩選表.xls").SaveAs "C:\Users\viva\Downloads\轉出資料\" & nName & ".xls"
' 另外這邊另存的新檔名稱會是nName.xls.xls
Workbooks.Close
Workbooks(2).Close

這邊有問題
首先你執行VBA的表單是???
如果是篩選表,VBA沒辦法幫自己令另存檔
然後把第一張表跟第二張關掉
這邊有產生一個問題如果你的表單只有2張都關光了誰做事?
所以他只跑一次

建議先把while拿掉,一條一條跑過一次沒問題再加上while

akissiva iT邦新手 5 級 ‧ 2020-09-22 18:07:42 檢舉

海綿大大 謝謝
正在努力中

akissiva iT邦新手 5 級 ‧ 2020-09-22 18:16:57 檢舉

sk大大
剛剛逐行跑後,我也發現了這個很ㄎㄧㄤ狀況 /images/emoticon/emoticon13.gif

因此把原本程式碼內有"篩選表.xls"的,都改成Workbooks(1)
然後最後面只關閉Workbooks(2).Close,Workbooks(1)只存檔而不關

好的,我試試把while先拿掉,一加進for就整個怪怪的

謝謝

akissiva iT邦新手 5 級 ‧ 2020-09-22 18:22:21 檢舉

把while先拿掉後,整個程式是沒有問題的
跑第二次,檔案仍是開第一個,不會開第二個/images/emoticon/emoticon06.gif
阿阿...迴圈,弄了4天還是卡在這

skyksl066 iT邦新手 5 級 ‧ 2020-09-22 18:23:44 檢舉

能幫上忙就好了,哈哈哈
最後還有一個問題saveAs完之後狀態列上的篩選表.xls變成x.xls了第二輪也沒有篩選表.xls可以選中了

skyksl066 iT邦新手 5 級 ‧ 2020-09-22 18:23:49 檢舉

能幫上忙就好了,哈哈哈
最後還有一個問題saveAs完之後狀態列上的篩選表.xls變成x.xls了第二輪也沒有篩選表.xls可以選中了

佔了一格隨便打點什麼好了。

1.excel VBA腳本
2.然後去開啟篩選表
3.開啟csv
4.do something
5.另存篩選表
6.關閉另存的篩選表
7.關閉csv
8.回2

建議流路設計(只是建議)

skyksl066 iT邦新手 5 級 ‧ 2020-09-22 18:24:29 檢舉

手機怪怪的發了二次XD

akissiva iT邦新手 5 級 ‧ 2020-09-22 18:33:38 檢舉

sk大
我是以不關閉的Workbooks(1).Activate用來當底,只需反覆貼上不同資料另存,

真的不知道問題出在哪....到底為什麼不能持續往下開資料夾內檔案運作...../images/emoticon/emoticon46.gif

skyksl066 iT邦新手 5 級 ‧ 2020-09-22 18:52:35 檢舉

你可以把,最新版的程式碼貼上來看看

akissiva iT邦新手 5 級 ‧ 2020-09-22 19:43:17 檢舉

sk大
目前程式長這樣

Sub Macro1()
    Dim mFile As String
    mFile = Dir("C:\Users\vi\Downloads\原始資料\*.csv")
    Do While mFile <> ""
        Debug.Print mFile

            Workbooks.Open Filename:="C:\Users\vi\Downloads\原始資料\" & mFile
            mFile = Dir()
            Range("A1:E5").Select
            Selection.Copy
            Workbooks(1).Activate
            Sheets(Array("s2", "s3", "s4", "s5", "s6", "s7", "s8", "s9", "s10", "s11", "s12", _
             "s12")).Select
            Sheets("s2").Activate
            Range("A2").Select
            Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
            nName = Application.Workbooks(2).Name
            Workbooks(1).SaveAs "C:\Users\vi\Downloads\轉出資料\" & nName & ".xls"
            Workbooks(2).Close

        mFile = Dir
    Loop
End Sub
skyksl066 iT邦新手 5 級 ‧ 2020-09-22 20:20:15 檢舉

這邊不容易讀發到下面

我要發表回答

立即登入回答