[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『単票から一覧への集計』（梶山）
お世話になります。どうぞお教えください。
ExcelでA4印刷にちょうど良くセルを配置した単票があります。 これは昔、紙にペンで記入していた日報の形式そのままです。 これを一覧表に集計しなくてはならなくなりました。
先任者は1セル1セルコピーして貼り付けていたようなのですが、 先月からその日報を利用する支所が増加。手でやっていては日が暮れても終わらず、 作ったこともないマクロにチャレンジ中です。
日報の形式はU1にデータがあったり、F5にデータがあったり、見た目重視なので規則性はありません。 リストの方は3行目にタイトルがあり、その下にデータを一行で追加していくタイプです。
現在は単票をリストと同じブックにコピーして、マクロを走らせてみました。 なんとか動くようなのですが。
前置きが長くなりましたが質問です。 １）マクロはおかしいところはあるでしょうか？ ２）できれば単票をリストのブックにコピーすることなく、別ブックのまま、リストに したいと思うのですが、どうしたらよろしいのでしょうか？ リストのブックは「集計.xls」で単票は各支所から「○○（支所名）日報.xls」 という名前のが毎日１ファイルずつきます。 同じフォルダに入れております。
Sub SYUKEI()
Dim AAA As Long
AAA = Sheets("リスト").Cells(Rows.Count, 1).End(xlUp).Row
If nRow < 3 Then nRow = 3
Sheets("単票").Range("U1").Copy
Sheets("リスト").Range("A" & AAA + 1).PasteSpecial Paste:=xlPasteValues
Sheets("単票").Range("U2").Copy
Sheets("リスト").Range("B" & AAA + 1).PasteSpecial Paste:=xlPasteValues
Sheets("単票").Range("U3").Copy
Sheets("リスト").Range("V" & AAA + 1).PasteSpecial Paste:=xlPasteValues
Sheets("単票").Range("F5").Copy
Sheets("リスト").Range("C" & AAA + 1).PasteSpecial Paste:=xlPasteValues
Sheets("単票").Range("AG7").Copy
Sheets("リスト").Range("E" & AAA + 1).PasteSpecial Paste:=xlPasteValues
Sheets("単票").Range("K8").Copy
Sheets("リスト").Range("F" & AAA + 1).PasteSpecial Paste:=xlPasteValues
～これがえんえんと続くので省略～
Sheets("単票").Range("AG44").Copy
Sheets("リスト").Range("G" & AAA + 1).PasteSpecial Paste:=xlPasteValues
End Sub
どうぞよろしくお願いいたします。 Windows7,Excel2010
If nRow < 3 Then nRow = 3 は If AAA < 3 Then AAA = 3 のつもりでしょうか（AAA よりは nRow の方がよいと思いますけれど）。
ブック間のコピーをするには Sheet の前にWorkbook(ブック名)をつければよいですが、 複数ファイルを処理するなら変数を使ったほうがいいですね。
セルを一つ一つコピーするのなら
Sheets("単票").Range("U1").Copy
Sheets("リスト").Range("A" & AAA + 1).PasteSpecial Paste:=xlPasteValues
ではなく
Sheets("リスト").Range("A" & AAA + 1).Value = Sheets("単票").Range("U1").Value
でいいです。
AAA+1 を全体でやるなら、最初に AAA = AAA + 1 としておけば、後は AAA だけでいいですね。
他の方からもアドバイスあると思いますが、とりあえず気が付いた点まで。
追伸：校内全文検索で「ファイル 収集」などすると似た例がありそうな気がします。 (Mook)
まっさきに思い浮かんだ。 【参考】みやほりんの失敗談。 http://miyahorinn.fc2web.com/schooltxt/Ex060120.html (ROUGE)
Mookさま
ご指導ありがとうございます。
おはずかしい。 If nRow < 3 Then nRow = 3 は If AAA < 3 Then AAA = 3 のつもりです。 つもりというより、最初の時にわけもわからず参考書からひっぱってきたままになっています。 すっかり変更するのを忘れていました。
また、変数もAAAよりnRowの方がいいなら、変えることにいたします。 どういうのがよい変数なのかもわかりません。
> ブック間のコピーをするには Sheet の前にWorkbook(ブック名)をつければよいですが、
うまくいきませんでした… せっかく教えていただいたのに、なにかずいぶん間違ったことをしたようなので、もう少し調べてから またまいります。
> セルを一つ一つコピーするのなら
目からうろこでした。コピーしなければ、と思い込んでおりました。 また、 AAA + 1 を最初に宣言しておくというのも言われて気が付きました。 本当にありがとうございます。
「ファイル 収集」で検索して勉強してまいります！
ROUGEさま
まったくそのお話の通りです。 最初からリスト形式で入力してもらえばいいものを、 「横に長くて入力しづらい」の一言で入力してくれない方たちが多いそうで。 もう5年もしたら古い方々がいなくなって、形式変えられるから、と上司は言いますが、 5年も耐えられません…
（梶山）
実際の対応する、転記先列名、転記元アドレスを列挙下記の様に、変数に取り込めば、
コードは簡素化できます。
Sa = Split("A,B,V,C,E,F,G", ",") 'リスト
Sb = Split("U1,U2,U3,F5,AG7,K8,AG44", ",") '単票
シート名に、ファイル名を指定装飾すれば、別ファイル間でも OKです。
サンプルは、単票のあるファイルへ、リストシートを作成して確認してください。
Sub Test()
Dim i&, nRow&, Sa, Sb
'転記元、転記先データを変数へセット
Sa = Split("A,B,V,C,E,F,G", ",") 'リスト
Sb = Split("U1,U2,U3,F5,AG7,K8,AG44", ",") '単票
With Sheets("リスト")
nRow = .Cells(.Rows.Count, "a").End(xlUp).Row + 1 '転記先行番号
For i = 0 To UBound(Sa)
.Cells(nRow, Sa(i)).Value = Sheets("単票").Range(Sb(i)).Value
Next
End With
End Sub
(暇人)
暇人さま
ご指導ありがとうございます。
セル先をこのように列挙して変数に取り込めるんですね！ びっくりいたしました。 これは配列というのですか？ また知らない機能が出てきました。 なんとなくやってることはわかる気がする……程度なので、また資料をひっくり返して勉強してきます。
> シート名に、ファイル名を指定装飾すれば
指定装飾…がわかりませんでした。 Workbooks.Open Filename := "c:\○○日報.xls" で開いてから実行かな？と思っていたのですが… こちらはまた明日調べたいと思います。 コードは実際の表で実行しましても問題なく動きました。 ありがとうございます！
（梶山）
毎日の支所からの日報集計だとすると、支所数はどの程度ですか ?
リストファイルの管理はどうなるのかな ?
例えば、シートを 12か月にして、1年分 ? それとも、月単位に作成 ?
どのように管理するかによって、管理コードも変わってきますね・・・・。
例えば: a) リストファイルに、コードを作成し、毎日の各支所の日報を呼び込み、リストファイル内にデータ集積。 b) システムファイルを別個に作成し、日報、リストファイル間のデータ転記処理 等・・・。
ファイル名の装飾とは、シート名に実際のファイル名を付けることです。
例えば、
With Workbooks("リストF.xls").Sheets("5月")
nRow = .Cells(.Rows.Count, "a").End(xlUp).Row + 1
For i = 0 To UBound(Sa)
.Cells(nRow, Sa(i)).Value = _
Workbooks("AAxxx日報.xls").Sheets("単票").Range(Sb(i)).Value
Next
End With
当然ですが、両ファイルとも開いているとの前提です。
日報ファイルを次々と開いて、そのデータを取り込む処理も当然可能です。
運用上のニーズが、難しくなればコードも当然それなりに・・・・・。 いずれにしても、基本的な構想を決めることがまず第一歩ですね。 (暇人)
暇人さま
引き続きご指導ありがとうございます！
急ぎの仕事が入り、いまだ理解が追い付いておりません、申し訳ありません。 装飾のご説明ありがとうございます。 こういう風にさらに詳しく書くことをいうのでしょうか？ 専門用語？がわからずお手数をおかけしました。 この書き方も調べてきます。
> 毎日の支所からの日報集計だとすると、支所数はどの程度ですか ? > リストファイルの管理はどうなるのかな ?
支所数は24になりました。 リストファイルの管理……いままで3支所だけだったので１シートに1年分を入れておりました。 24支所×356日（本当は休日があるので違いますが）＝8760 9千行くらいだったら１シートに収まりますよね？ たぶん部長が形式を変えるのを嫌がるので、昨年と同じく１シートに1年分、１ブックに5年分だと思います。
そして処理内容としては > a) リストファイルに、コードを作成し、毎日の各支所の日報を呼び込み、リストファイル内にデータ集積。 を想定しておりました。 日報の方は各支所に元ファイルがあるのでほとんど変更できません。 こちらでいじれるのがリストファイルだけでしたので、a) のものをつくりたいと思っております。 できれば a)の内容に > 日報ファイルを次々と開いて、そのデータを取り込む処理 をやろうとしております。 （まだ必要なコードを調べている状態で動かせるコードまで行っておりませんが）
つまり現状の想定は
日報とリストのブックを1つのフォルダに入れる（中は25ブックのみ） リストブックを開く マクロを実行 日報の一つが自動で開く 教えていただいたコピーするコードを実行 コピーが終了後開いた日報が閉じる 次の日報が開く ～くりかえし～ 全部の日報のコピーが終わったらマクロを終了 （リストのブックは開いたまま、人間は結果を確認）
です。 可能かどうかさえ、現在調べている最中です…
ちなみに b) のようなことができるとは知らなかったので、a) を想定していたともいいます。
このような説明になりますが「基本的な構想」に当てはまりますでしょうか？ 名前のない方
いえ違います。 消防に勤めていたことはありません。 お知り合いに似た方がいらっしゃるのでしょうか？ 親近感がわきますね（笑）
（梶山）
基本的な Dir関数を利用した、連続処理のサンプルです。 リストファイルと、日報ファイルは同じ Folder上にあること。 日報ファイル名には、必ず 日報 の文字列を含み、単票シートが存在する事。 作業中のファイルには、リスト シートが存在する事。
実際の転記項目は、何項目位ですか ? Sa,Sb には、実際のデータを Set して下さい。 24 File も、処理すると多少時間が気になるかな・・・。 細かなテストはしていませんので悪しからず・・・。
転記する日報の順序はどうでもいいのかな ? 毎日の、Folder管理が結構大変そうですね・・。転記済み、未転記の区分
Sub TestB() Dim i&, j&, nRow&, Sa, Sb Dim PName$, FName$
'転記元、転記先位置データを変数へセット
Sa = Split("A,B,V,C,E,F,G", ",") 'リスト
Sb = Split("U1,U2,U3,F5,AG7,K8,AG44", ",") '単票
PName = ThisWorkbook.Path & "\" '現在作業中の File の Path名 & "\"
FName = Dir(PName & "*.xls*") '開くBook名 (ExcelFile)
Application.ScreenUpdating = False
Do While FName <> ""
If FName Like "*日報*" Then '日報Fileのみ対象
Workbooks.Open PName & FName
With ThisWorkbook.Sheets("リスト")
nRow = .Cells(.Rows.Count, "a").End(xlUp).Row + 1
For i = 0 To UBound(Sa)
.Cells(nRow, Sa(i)).Value = _
Workbooks(FName).Sheets("単票").Range(Sb(i)).Value
Next
End With
Workbooks(FName).Close False '保存せずに終了
End If
FName = Dir() '次のBook名
Loop
Application.ScreenUpdating = True
End Sub
(暇人)
暇人さま
本当にありがとうございます！
すみません、急ぎの仕事がまだ終わらないので、せっかく書いていただいたのに ぜんぜん見れておりません。 申し訳ないです……
明日には、なんとか時間を作ってみてみます。
本当にありがとうございます！！！
（梶山）
暇人さま
遅くなりまして申し訳ありません。
無事に動きました！ 開いたリストファイルが表示されたまま、後ろでファイルが開いたり閉じたりして、30秒くらいで出来上がりました。 24行、間違いなくリストになりました。
自分がおととい調べつつ作っていたのはファイルの名前指定して開いて閉じて、……と繰り返しておりまして、 まさかこんなことができるのかと感動です。 自分一人で考えていても、こうはならなかったと思います。 本当にありがとうございます。
Sa,Sb にセットしたのは39セルずつです。横に長くなりましたｗ
転記する日報の順序は、日報の日付順＆支所番号順に後からソートするので大丈夫です。
毎日の、Folder管理は……昨年度まで毎日３ファイルでしたので、あまり大変ではなかったようです。 先月は毎日の日付のフォルダごとに整理してあります。1年たったらきっと300フォルダほど出来上がるのでしょう。 私としては毎日バックアップを取っておくことくらいしかできません……
書いていただいたマクロなのですが、もしよろしければお時間のある時にでも、下記をお教えいただけないでしょうか？
１）変数の後ろについている＄や＆は変数のデータ型を示しているのでしょうか？ As ○○ と書くものの代わりかな？と思ったのですが、手元の本に載っておりません。 何なのかお教えいただけますか？
２）変数の j& はなにに使ったものなのでしょうか？
３）.Cells(nRow, Sa(i)).Value = _ にありますアンダーバー（ _ ）はどういう意味ですか？ 下の行がアンダーバーのところの内容だと思うのですが、すぐ下の行の内容の置き換えみたいな意味ですか？
最後までお手数をおかけして申し訳ありません。 気が向いたら結構ですので、どうぞよろしくお願いいたします。 （梶山）
まずは、無事動いたようで何よりです。 24File だと、10Sec 程度はかかるかなと思ってたのですが・・・・。 Sa,Sb の実際のデータを教えてください。も少し効率的な方法を考えてみます。 「データを、Exclファイルとして開く」処理が、最もコストのかかる処理です。( × 24回) ADO(Application DataBase Object)を利用して、ファイルを、バイナリレベル(コードレベル)で開いて処理する方法も在りますが、 もう少し基本を勉強してからチャレンジしてみてください。
お尋ねの件ですが
a) i&, PName$ 等の、& , $ 等は、「型宣言文字」といい、i& → i As Long PName$ → PName As String
と同じ意味になります。ちなみに何もつけない、Sa, Sb は、バリアント型の宣言となります。
他にも、%,!,#,@ 等色々とあるので、ご自分で確認してください。
私は、コーディングが簡単なのできるので、もっぱらこっちを愛用しております。
コードを書くとき、汎用的な i&,j&,m&,n& 等は習慣的に最初に宣言してしまいます。今回の j& は、消し忘れです。
b) コードは、基本的に、1行、1オーダー が原則です。しかし
.Cells(nRow, Sa(i)).Value = Workbooks(FName).Sheets("単票").Range(Sb(i)).Value
1行にすると長くなる場合、(半角空白セル + _ ) として改行した場合は、1行のコードとして認められる約束事になっています。
但し、計算式の途中や、文字列の途中で改行するとエラーとなるので注意が必要です。
独り言 わずか、40セル程度の日報データを保存するのに、何十ページもの、Excelというノートを、1冊づつ使用 年間 360冊 ものすごい無駄遣いだと思いませんか ? 最近は、PCの普及に伴い、各企業でもどこでも、サーバーをいくら増設しても追い付かない現状に頭を痛めています。 (暇人)
あまり変わらないかな ? 転記処理を、全て配列内で行っています。 配列内では、Rangeオブジェクトが使えないので、Sa,Sb を更に数値変換しています。 Sa,Sb は、そのまま実際のものと入れ替えてください。 「単票」の利用範囲が、50行*50列より大きいと、エラーになります。場合によっては変更してください。
Sub TestC()
Dim i&, j&, nRow&, Sa, Sb, v, w
Dim Pname$, Fname$, Sm$, t!
Dim n&, r&, c&
t = Timer
'転記元、転記先データを変数へセット
Sa = Split("A,B,V,C,E,F,G", ",") 'リスト
Sb = Split("U1,U2,U3,F5,AG7,K8,AG44", ",") '単票
'Sa,Sbを数値へ変換
For i = 0 To UBound(Sa)
Sa(i) = Cells(1, Sa(i)).Column '
Sb(i) = Range(Sb(i)).Row & "_" & Range(Sb(i)).Column
Debug.Print Sb(i)
Next
ReDim w(1 To 25, 1 To 40) '展開用配列準備 25行*40列分
Pname = ThisWorkbook.Path & "\" '
Fname = Dir(Pname & "*.xls*") '開くFile名
Application.ScreenUpdating = False
Do While Fname <> ""
If Fname Like "*日報*" Then '日報Fileのみ対象
Workbooks.Open Pname & Fname
v = Workbooks(Fname).Sheets("単票").Range("A1").Resize(50, 50).Value 'Max 50*50 ?
n = n + 1 'w への記入位置行番号
For i = 0 To UBound(Sa)
r = Split(Sb(i), "_")(0)
c = Split(Sb(i), "_")(1)
w(n, Sa(i)) = v(r, c) 'v → wへデータ集積
Next
Workbooks(Fname).Close False '保存せずに終了
End If
Fname = Dir() '次のFile名
Loop
Application.ScreenUpdating = True
With Sheets("リスト") '展開処理 ***
nRow = .Cells(.Rows.Count, "a").End(xlUp).Row + 1
.Cells(nRow, 1).Resize(25, 40).Value = w
End With
MsgBox Timer - t & " Sec"
If n = 24 Then '***
Sm = n & " 件 転記完了!!"
Else
Sm = "転記 " & n & " 件 ? " & vbCr & "確認してください !!" '24件ない場合
End If
MsgBox Sm
End Sub
(暇人)
暇人さま
ご指導ありがとうございます。 a)もb)もよくわかりました。 ＆等で代用できるなんて便利ですね。なにより綴り間違いを心配しなくていいです！
> 汎用的な i&,j&,m&,n& 等は
やっぱりなにかお約束的な変数があるのですね。 これもじっくり調べてみます。
Sa,Sb の実際のデータですが、遅いですけれど一応載せておきます。
Sa = Split("A,B,X,C,E,F,G,H,I,J,K,D,L,M,N,P,Q,R,S,U,T,O,W,V,AA,AB,AC,AD,AE,AF,AG,AH,AI,AJ,Y,Z", ",")
Sb = Split("U1,U2,U3,F5,AG7,K8,AG9,K10,AG11,K12,F13,F15,F17,F27,F28,F38,V38,F39,V39,F40,V40,F41,F42,F44,AH45,AH46,AH47,AI45,AI46,AI47,F46,F47,AI38,AI40,AI42,AI43", ",")
御覧のように統一性がありません。 好き勝手にセルを統合し、入力先がばらばらになっているんです。
そして新しいコードをありがとうございます！ これは、なんというか、メモリの中にｗを作ってそこにデータをためて、最後に一気にリストに貼り付けている、ということでしょうか？ こんなこともできるんですね…！
きっといつか「ファイルを、バイナリレベル(コードレベル)で開いて処理する方法」も理解してやってみたいです。
あと、この新しいコード、時間出てきました。 30.36719sec でした。 なんだかわくわくして、前に頂いたコードにも貼ってみました。 31.48828sec でした。 無意味に自分でいじった失敗作にも貼って遊びたくなりましたｗ
転記数のチェックまでしていただいてありがとうございます。 地味に楽になりますね、これ。 フォルダに入れるファイルの数のカウントや、データの確認はあまり手間な作業とは意識してなかったのですが、便利で驚きです。 お気遣いありがとうございます。
本当に助かりました。ありがとうございます。
独り言（という名の愚痴混じりコメント） ものすっごく無駄だと思っております。 先任の方もだいぶ戦ったようなのですが、日報をリスト形式にすることも、共有フォルダにデータベースを置くこともできませんでした。
亀の歩みですが、実績データを取りつつ、部長を説得して。 少しずつでも前進していきたいと思っております。 ……IT部の方にはなるべくご迷惑をおかけしないよう、頑張ります。 （梶山）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.