[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ファイルが増えた時の対応方法』(kiss)
いつも大変お世話になっております
ご教示頂けたら幸いです
同一フォルダー CSVファイルを 1シートに纏めています
Sub A CSVファイルを開いて シート追加しています
Sub B 各シート 整形しています
Sub C 一枚に纏めてます
このときに 営業所等増えた時 ワイルドカード使用にて
マクロメンテナンスを掛けずに一連の処理を行いたいです
どの様に書けばいいのでしょうか
既存ファイルにはsheet1からsheet5までは既存配備されています
Private Sub CommandButton17_Click()
Worksheets("Sheet1").Activate
Cells.Select
Selection.ClearContents Call A Call B Call C end Sub
Sub A()
Application.ScreenUpdating = False
Set mb = ThisWorkbook
myfdr = ThisWorkbook.Path
fname = Dir(myfdr & "\*.csv")
Do Until fname = Empty
If fname <> mb.Name Then
Set wb = Workbooks.Open(myfdr & "\" & fname)
wb.Worksheets.Copy before:=mb.Sheets(mb.Sheets.Count)
wb.Close
n = n + 1
End If
fname = Dir
Loop
Application.ScreenUpdating = True
End Sub
Sub B()
On Error Resume Next
Sheets("茨城 経費明細表").Select Range("C6").Copy Range("A13") n = Cells(Rows.Count, "B").End(xlUp).Row
Range("A13").Select
Selection.AutoFill Destination:=Range("A13:A" & n), Type:=xlFillDefault Rows("1:11").Delete Shift:=xlUp
Sheets("広島 経費明細表").Select Range("C6").Copy Range("A13") n = Cells(Rows.Count, "B").End(xlUp).Row
Range("A13").Select
Selection.AutoFill Destination:=Range("A13:A" & n), Type:=xlFillDefault Rows("1:11").Delete Shift:=xlUp Sheets("岡山 経費明細表").Select Range("C6").Copy Range("A13") n = Cells(Rows.Count, "B").End(xlUp).Row
Range("A13").Select
Selection.AutoFill Destination:=Range("A13:A" & n), Type:=xlFillDefault Rows("1:11").Delete Shift:=xlUp Sheets("九州 経費明細表").Select Range("C6").Copy Range("A13") n = Cells(Rows.Count, "B").End(xlUp).Row
Range("A13").Select
Selection.AutoFill Destination:=Range("A13:A" & n), Type:=xlFillDefault Rows("1:11").Delete Shift:=xlUp Sheets("東京 経費明細表").Select Range("C6").Copy Range("A13") n = Cells(Rows.Count, "B").End(xlUp).Row
Range("A13").Select
Selection.AutoFill Destination:=Range("A13:A" & n), Type:=xlFillDefault Rows("1:11").Delete Shift:=xlUp Sheets("大阪 経費明細表").Select Range("C6").Copy Range("A13") n = Cells(Rows.Count, "B").End(xlUp).Row Range("A13").Select Selection.AutoFill Destination:=Range("A13:A" & n), Type:=xlFillDefault Rows("1:11").Delete Shift:=xlUp
End Sub
Sub C()
On Error Resume Next
Sheets("茨城 経費明細表").Range("A1:BF" & Range("BF1048576").End(xlUp).Row).Copy Worksheets("Sheet1").Range("A1") Sheets("大阪 経費明細表").Range("A2:BF" & Sheets("大阪 経費明細表").Range("BF1048576").End(xlUp).Row).Copy Worksheets("Sheet1").Range("A1").End(xlDown).Offset(1, 0) Sheets("東京 経費明細表").Range("A2:BF" & Sheets("東京 経費明細表").Range("BF1048576").End(xlUp).Row).Copy Worksheets("Sheet1").Range("A1").End(xlDown).Offset(1, 0) Sheets("岡山 経費明細表").Range("A2:BF" & Sheets("岡山 経費明細表").Range("BF1048576").End(xlUp).Row).Copy Worksheets("Sheet1").Range("A1").End(xlDown).Offset(1, 0) Sheets("広島 経費明細表").Range("A2:BF" & Sheets("広島 経費明細表").Range("BF1048576").End(xlUp).Row).Copy Worksheets("Sheet1").Range("A1").End(xlDown).Offset(1, 0) Sheets("九州 経費明細表").Range("A2:BF" & Sheets("九州 経費明細表").Range("BF1048576").End(xlUp).Row).Copy Worksheets("Sheet1").Range("A1").End(xlDown).Offset(1, 0)
End Sub
< 使用 Excel:Excel2010、使用 OS:Windows7 >
> fname = Dir(myfdr & "\*.csv") しっかりワイルドカードを使っており、ファイルが増えても対応できるコーディングになっているようですが?
出力先が増えることに対応したい、という事ならば、「広島」とか「東京」の文字列を配列化しておき、配列数分ループするようにしてはいかがでしょうか?
(貴方の「仕事」を私が代わりにやるつもりはありませんので、コードは要求しないように。必要なものは全て既に書かれてますよね)
(???) 2016/06/16(木) 14:53
確かに ファイルオープンは ちゃんとワイルドカード使っています
出力先の対応を教えていただきたいのが事実です
下記の部分について貴方が感じる事だと思います
(貴方の「仕事」を私が代わりにやるつもりはありませんので、コードは要求しないように。必要なものは全て既に書かれてますよね)
あくまでも 善意の有る質問箱とおもっていました
これでは 好意的には感じられません 好意的に対応していただけるなら
スルーしていただくのが 大人の好意的な場所と心得ますが
如何な物でしょうか???
強制して 貴殿に やってくれなんて ひと言も言ってません
個人個人レベルも違うし アップしたコードから レベルを読み取れるかもしれません
しかし
私のように 前任から任された まるっきり コードも解らない立場の様な人もいます
詰まんない質問して 申し訳御座いませんでした
もう此処にはきません
(kiss) 2016/06/16(木) 15:03
お答えいただいてる先生方は 基本 自慢したいから
答えてるものだと思っています
そうでなければ 基本人に何かを求めた時
代償が ありがとう のひと言で終わる分けないと思います
中には暇つぶしの人もいると思います
教えるのが好きな人とか 色々でしょ
逆に質問者も色々だと思います
ソフトが優秀になり その分誰でも 簡素化作業がしやすくなっている状態だからこそ
このような場が 盛り上がるものと考えています
長い間 色々な方にご指導頂き 本当に有難う御座いました
(kiss) 2016/06/16(木) 15:23
Dim sht As Worksheet On Error Resume Next For Each sht In ThisWorkbook.Worksheets 'Sheet1からSheet5は既存なので処理対象外。これら以外のシートが対象 If (sht.Name <> "Sheet1") And (sht.Name <> "Sheet2") And (sht.Name <> "Sheet3") And (sht.Name <> "Sheet4") And (sht.Name <> "Sheet5") Then sht.Select Range("C6").Copy Range("A13") n = Cells(Rows.Count, "B").End(xlUp).Row Range("A13").Select Selection.AutoFill Destination:=Range("A13:A" & n), Type:=xlFillDefault Rows("1:11").Delete Shift:=xlUp End If Next sht End Sub Sub C() Dim sht As Worksheet On Error Resume Next For Each sht In ThisWorkbook.Worksheets If (sht.Name <> "Sheet1") And (sht.Name <> "Sheet2") And (sht.Name <> "Sheet3") And (sht.Name <> "Sheet4") And (sht.Name <> "Sheet5") Then If sht.Name = "茨城 経費明細表" Then sht.Range("A1:BF" & Range("BF1048576").End(xlUp).Row).Copy Worksheets("Sheet1").Range("A1") Else sht.Range("A2:BF" & sht.Range("BF1048576").End(xlUp).Row).Copy Worksheets("Sheet1").Range("A1").End(xlDown).Offset(1, 0) End If End If Next sht End Sub (mm) 2016/06/16(木) 15:26
> 出力先が増えることに対応したい、という事ならば、「広島」とか「東京」の文字列を配列化しておき、配列数分ループするようにしてはいかがでしょうか?
私は、どう直せば出力もコードをまとめられるか、方針をちゃんと書いていますよ。こっちが本題であり、括弧書きはおまけです。
何も案を出さずに文句だけ付けるということは、いつもしていないつもりです。
コードは要求しないように、というのは、これを受けて多くの方が「書き方が判りません」と試しもしないで再質問されるので、釘を刺したまでです。今回の質問も、現在のコードをそのまま提示されただけであり、これをこう直してみたけどここがこうなってしまう、まで書かれていないので、同じになりそうに思いました。
(???) 2016/06/16(木) 16:01
>お答えいただいてる先生方は 基本 自慢したいから >答えてるものだと思っています
先生だと思っていませんよ。質問する人も回答する人も、等しくプログラムに関わる仲間と思っています。
同じ立場なので、「先生」とか「様」とか目上の敬語はくすぐったいので、多くの人は敬称に「さん」付けを好みます。
自慢? そんな事は全く思っていなくて、単に困っている人がいて、自分なら簡単に助けられる状態だから手を差し伸べる、というだけ。人助けって、何も打算的な考えはしないと思いますよ。
>そうでなければ 基本人に何かを求めた時 >代償が ありがとう のひと言で終わる分けないと思います
いや、一言で十分ですよ。個人情報を晒したり、ポイントでランキング作っていたりしている訳でもなし。
なんにも見返りなんか求めていません。 身近な人ならば、昼飯とか缶コーヒー奢れよ、とかあるかもですが。
「解決しました。」と聞けると、ほっとしますね。
じゃあなんで自分の時間を割いてまで回答するの?、ということでしたら、流しているプログラムが終わるまでの待ち時間だったり、仕事の区切りの気分転換だったりですかね。 こんな数分の対応でも、助かる人がいるならOK、という感じです。
(???) 2016/06/16(木) 16:48
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.