[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ファイルが増えた時の対応方法』（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.