[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『マクロボタンを押したら、コピーしたデータを、数種類のファイルに自動貼り付け』(ALO)
記帳日 発注先名 店名 現場名 注番 商品名 数量 金額
12/2 山善 A 池永邸 23-744 断熱材 1 296,100
12/6 山善 B 松村邸 6-396 給湯器 1 71,004
12/25 紅中 C 山本邸 26-907 カート 1 18,000
12/26 紅中 D 北川邸 23-920 カウンタ 2 8600
1/5 南商店 E 田中邸 32-1 太陽光 1 1000000
発注先名とは一致しないファイルがいくつか存在します。
たとえば、「1.山善」「2.紅中」「その他」などです。
上記データをコピーして、マクロボタンを押すと、それぞれ入力したい発注ファイルの
一番最後の行に自動的に値のみ貼り付けして、貼り付けたファイルはそのまま閉じるようなマクロはありますでしょうか?
マクロ初心者のため、どなたかご教示いただけますと助かります。
< 使用 Excel:Excel2013、使用 OS:Windows7 >
ファイル とは ブックですか? マクロブック内のシートですか?
ブックの場合は、ブック名のことですか? そのブックの、なんというシートに貼り付けるのですか? また、こおのブックはどこに保存されているのですか?
シートの場合、シート名のことですか?
「上記データをコピーして」どこにコピーするのですか?
「その他」には何をコピーするのですか?
(β) 2015/03/26(木) 17:07
横からすみません 運用方法が尋常じゃないと思います ブック毎に分けたデータをどの様に活用するのですか? 集計にしろ、閲覧にしろ、全てはいったデータベース からフィルタなりピボットなりマクロなりで 都度出力すればいい話ではないですか?
あげてもらった例で、その他と山善を集計したくなったとき 別のブックでは不便ですよね? (稲葉) 2015/03/27(金) 05:19
稲葉さんのコメントに100票! ですね。
話はそれますが、よく、「最終報告書スタイル」のシートレイアウト(罫線があったり結合セルがあったり、行がとびとびで配置されていたり) に対するデータ処理(蓄積や加工)の質問がよくアップされます。
で、レイアウトが扱いにくいので、コードもやっかいなものになることが間々あります。
データはデータとしてシンプルなテーブル形式で、必ず1行目にタイトルがあって、列はA列から連続して配置。 こんなものにしておいて、必要なものを、その条件で抜出し、必要があれば、見栄えの良い報告書に加工編集する。
こういう構成がいいと思いますよ。
で、このデータは、最初は、エクセルシートでもいいでしょうし、量が膨大になれば、そこだけを専門のDBに移す。 そうすると、DBアクセスの部分だけをかえれば、編集処理プログラムは、ほとんどのロジックを継承できる。 いいことずくめだと思いますね。
(β) 2015/03/27(金) 07:20
毎回どこかに貼り付けたデータの書式を変え、該当のファイルを開き、
そこに入力しないといけないようです。
今は、全て手入力してるようです。
なので、せめてその部分をマクロ化できないかなと思った次第です。
無理なようなら、あきらめます。
(ALO) 2015/03/27(金) 10:29
できるけど、 >150件の発注先に対して、それぞれ保存したいファイル名(五個)の一覧を >作成しおけば、マクロを組んで一気に貼り付けたいファイルの最終行に >保存する事は可能でしょうか? 一覧にない発注先はどう判別するとか、 既にコピーが済んでいるデータはどこを見ればわかるのか 元のデータは残すのか、消すのか 誤って入力したときに後追いができるのかとか
色々仕様考えないとだめでしょうね。
一度直談判してみたらどうでしょう? それか支店がたくさんあるなら、簡素化されてるところもあるでしょうし。 (稲葉) 2015/03/27(金) 10:59
とりあえず、そちらの要望の(と思われる)コードをアップしておきます。 ★のところは適宜、実際のものに。 Dドライブ直下のエクセルブック(いくつあってもOK)名とマクロブックの発注先名をLike 比較して当該のブックに追加。 マッチしないものは、その他.xlsx に追加します。
要件誤解しているところがあれば指摘してください。 今から外出するので、何かあれば、コメントアップしておいてください。
Sub Test() Dim fName As String Dim fPath As String Dim dic As Object Dim d As Variant Dim otName As String Dim cR As Range Dim fR As Range Dim bR As Range Dim c As Range Dim w As Variant Dim Target As String Dim sh As Worksheet
Application.ScreenUpdating = False
fPath = "D:\" otName = "その他.xlsx" '★その他を格納するブック名 Set dic = CreateObject("Scripting.Dictionary")
fName = Dir(fPath & "*.xls*")
Do While fName <> "" If fName <> otName Then w = Split(fName, ".") dic(fName) = w(UBound(w) - 1) 'キー:ブック名、アイテム:拡張子を除いたもの End If fName = Dir() Loop
With ThisWorkbook.Sheets("Sheet1") '★マクロブックのリストがあるシート。シート名は実際のものに。 .AutoFilterMode = False '念のためオートフィルター解除 Set fR = .Range("A1").CurrentRegion 'リスト領域 Set bR = Intersect(fR, fR.Offset(1)) 'リストのデータ領域 Set cR = .Cells(1, fR.Columns.Count + 2) 'リスト領域から1列あけて作業列を設ける fR.Columns(2).Offset(1).Resize(fR.Rows.Count - 1).Copy cR '発注先をタイトル行を除いてコピー cR.CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlNo '重複の削除で一意の発注先リストに End With
For Each c In cR.CurrentRegion '発注先の取り出し
fR.AutoFilter Field:=2, Criteria1:=c.Value
'発注名に紐付くブックの判定 Target = otName For Each d In dic If dic(d) Like "*" & c.Value & "*" Then Target = d Exit For End If Next
Set sh = Workbooks.Open(fPath & Target).Sheets(1) '紐付いたブックを開き、最初のシートを取得
bR.Copy sh.Range("A" & sh.Rows.Count).End(xlUp).Offset(1) '末尾に追加(コピペ)
sh.Parent.Close True '開いたブックを保存して閉じる
Next
'オートフィルターの解除と作業域のクリア fR.AutoFilter cR.CurrentRegion.Clear
MsgBox "処理が完了しました。"
End Sub
(β) 2015/03/27(金) 12:13
紐付くブックの判定をループなしにしたものも。
Sub Test2() Dim fName As String Dim fPath As String Dim dic As Object Dim d As Variant Dim otName As String Dim cR As Range Dim fR As Range Dim bR As Range Dim c As Range Dim Target As String Dim sh As Worksheet Dim reg As Object Dim mt As Object Dim checkStr As String
Application.ScreenUpdating = False
fPath = "D:\" otName = "その他.xlsx" '★その他を格納するブック名 Set dic = CreateObject("Scripting.Dictionary") Set reg = CreateObject("VBScript.RegExp")
fName = Dir(fPath & "*.xls*")
Do While fName <> "" If fName <> otName Then dic(fName) = True End If fName = Dir() Loop
If dic.Count > 0 Then checkStr = vbTab & Join(dic.keys, vbTab) & vbTab 'ブック名を連結した検索用文字列 End If
With ThisWorkbook.Sheets("Sheet1") '★マクロブックのリストがあるシート。シート名は実際のものに。 .AutoFilterMode = False '念のためオートフィルター解除 Set fR = .Range("A1").CurrentRegion 'リスト領域 Set bR = Intersect(fR, fR.Offset(1)) 'リストのデータ領域 Set cR = .Cells(1, fR.Columns.Count + 2) 'リスト領域から1列あけて作業列を設ける fR.Columns(2).Offset(1).Resize(fR.Rows.Count - 1).Copy cR '発注先をタイトル行を除いてコピー cR.CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlNo '重複の削除で一意の発注先リストに End With
For Each c In cR.CurrentRegion '発注先の取り出し
fR.AutoFilter Field:=2, Criteria1:=c.Value
'発注名に紐付くブックの判定 Target = otName reg.Pattern = vbTab & "[^" & vbTab & "]*" & c.Value & "[^" & vbTab & "]*?" & vbTab '発注先ワイルドカード Set mt = reg.Execute(checkStr) If mt.Count > 0 Then 'マッチ Target = Mid(mt(0).Value, 2, mt(0).Length - 2) End If
Set sh = Workbooks.Open(fPath & Target).Sheets(1) '紐付いたブックを開き、最初のシートを取得
bR.Copy sh.Range("A" & sh.Rows.Count).End(xlUp).Offset(1) '末尾に追加(コピペ)
sh.Parent.Close True '開いたブックを保存して閉じる
Next
'オートフィルターの解除と作業域のクリア fR.AutoFilter cR.CurrentRegion.Clear
MsgBox "処理が完了しました。"
End Sub
(β) 2015/03/27(金) 13:47
私もマクロの神の領域になるよう勉強をつんでいきたいと思います。
(ALO) 2015/03/27(金) 15:44
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.