[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『各ファイルから合計数を抽出したい』（みの）
こんにちはぁ。 現在、マクロを勉強中なのですが、仕事内で100ファイルくらいあるエクセルの表（表は全て固定）より、 個数の合計数または空白ではない行数のみをカウントし、別ファイルの合計数欄に転記したいのですが、 この場合はどうしたらよいのでしょうか・・・。 VBAで抽出したいファイルを開き、行を選択し、コピー、合計数のみを別ファイルに貼付する。 こんな感じで途中まで作っているのですが、どうしてもうまくいきません。
'03.02.発注 『○○』フォルダ内の各ファイルを開き、ケース数を抽出する。
Workbooks.Open "X:\○○\××\△△.xls" ←抽出したいファイル
ActiveSheet.Name = "Sheet名"
Range("T6:T100").Select ←T列の数字を選択
Selection.Copy
Windows("××.xls").Activate ←合計のみ貼り付けたいファイル
Sheets("Sheet名").Select
↑中途半端でやめてますorz
ご教授よろしくお願いします。
もうひとつあるのですが、こちらは予定表なのですが 6000件以上あるデータの日付より 別ファイルの予定表に週別に仕分けしてセル毎に件数の合計を抽出したいのです。
予定表 2/5～2/11｜2/12～2/18｜ 予定 ｜ ｜ 実績 ｜ ｜ こんな感じのフォーマット ｜ ｜ 元となるデータ 商品名 完成予定日 完了実績日 ○○ 2007/1/28 2007/2/6 ×× 2007/2/10 ○○ 2007/2/5 2007/2/17 ×× 2007/2/18
上記を 2/5～2/11｜2/12～2/18｜ 予定 ２ ｜ １ ｜ 実績 １ ｜ １ ｜ ｜ ｜
このように自動で数値を抽出できるようにしたいのです。
現在、ピボットテーブルにて一度一週間単位で表を作り、予定表のセルに同じ週のセルを =GETPIVOTDATA という形で入力しています。 かなりの件数に手間がかかり、頭を抱えております。 このやり方ですと、件数がない週があると #REF!がでてしまうので・・・。
説明不足とは思いますが、どなたかよい方法はありませんでしょうか。
２週間深夜残業してしまい、今回は残業しないでほしいと言われ、期限は今週などと踏んだり蹴ったりなあたしに一つお助けを；ｗ；
文言が入ったセルの行数を知る方法があっても その数値を貼り付けることは可能でした？
（ぽんぞう）
行数に関しては、Msgboxでは出してもらえるようですが やぱりそのままコピペしても文字が入ってるから計算できないのかなぁ。
いろいろと調べてみますorz
（みの）
今、Book1.xlsとBook2.xlsのSheet1のT6:T100の数値合計を取り、Book3.xlsのSheet1のA1に結果を代入するとします。
Sub Macro2()
Dim gokei As Long '100ファイルあるので念のためLONG型で定義
Workbooks.Open "C:\Documents and Settings\Administrator\デスクトップ\Book1.xls"
Workbooks("Book1.xls").Activate
Workbooks("Book1.xls").Worksheets("Sheet1").Activate
Workbooks("Book1.xls").Worksheets("Sheet1").Range("A1").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[5]C[19]:R[99]C[19])" 'SUM関数を使ってT6:T100の数値を集計
gokei = gokei + ActiveCell.Range("A1").Value 'gokeiにSUMした数値を保存
Workbooks("Book1.xls").Saved = True 'ブックの変更をセーブしない
Workbooks("Book1.xls").Close 'ブックを閉じる
Workbooks.Open "C:\Documents and Settings\Administrator\デスクトップ\Book2.xls"
Workbooks("Book2.xls").Activate
Workbooks("Book2.xls").Worksheets("Sheet1").Activate
Workbooks("Book2.xls").Worksheets("Sheet1").Range("A1").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[5]C[19]:R[99]C[19])" 'SUM関数を使ってT6:T100の数値を合計
gokei = gokei + ActiveCell.Range("A1").Value 'gokeiにSUMした数値を保存
Workbooks("Book2.xls").Saved = True 'ブックの変更をセーブしない
Workbooks("Book2.xls").Close 'ブックを閉じる
Workbooks("Book3.xls").Activate '合計数を格納するブック・シートを選択
Workbooks("Book3.xls").Worksheets("Sheet1").Activate '合計数を格納するブック・シートを選択
Range("A1").Select
Range("A1").Value = gokei '合計した結果をA1に格納
End Sub
１）Book1にSUM関数を埋め込み合計値をgokeiに退避。セーブせずにブックを閉じる。 ２）Book2についても、上記と同様の処理を実施 ３）Book3に集計値を保存 ファイル名が固定なら、少々面倒ですが、ひたすら１）を繰り返せば何とかなるかと。 ホントは繰り返しを使うともっときれいなはずなんですが・・・たたき台って事で(^^;;
行数のカウントはCOUNTA関数で出来るのですが、今ちょっと時間が無いので(^^;; 時間が出来たら考えてみます。 後、２つめのも今は無理ですが、時間が出来た時に。 ｂｙ ｗｋｊ
上記のマクロ参考にさせていただきます！
行数はCOUNTA関数でできるのですねぇ、勉強になります(//ω//)
お忙しいところレスありがとうでしたぁあ^-^
（みの）
80ファイル？
Sub test()
Dim myDir As String, fn As String, rng As Range, wb As Workbook, txt
myDir = "c:\test\"
fn = Dir(myDir & "*.xls")
If fn = "" Then Exit Sub
Do While fn <> ""
Set wb = Workbooks.Open(myDir & fn)
With wb.Sheets("sheet1")
With .Range("t3",.Range("t" & Rows.Count).End(xlUp))
ThisWorkbook.Sheets(1).Range("a" & Rows.Count).End(xlUp).Offset(2).Resize(.Rows.Count).Value = .Value
txt = Join$(Array("Sum('",myDir,"[",fn,"]","Sheet1'!",.Address,")"),vbNullString)
MsgBox ExecuteExcel4Macro(txt)
End With
End With
wb.Close False
fn = Dir
Loop
End Sub
(seiya)
各ファイルのシート名と範囲が一定なら開かなくてもよさそうな...
Sub test()
Dim myDir As String, fn As String, sn As String, myRange As String
myDir = "c:\test\"
sn = "Sheet1"
fn = Dir(myDir & "*.xls")
If fn = "" Then Exit Sub
Do While fn <> ""
myRange = "'" & myDir & "[" & fn & "]" & sn & "'!R1C6:R100C6"
myTotal = ExecuteExcel4Macro("sum(" & myRange & ")")
ThisWorkbook.Sheets(1).Range("a" & Rows.Count).End(xlUp).Offset(1).Resize(,2).Value = Array(fn, myTotal)
myTotal = 0
fn = Dir
Loop
End Sub
(seiya)
綺麗な(Coolっすｗ)回答ありがとうございました。 確かに範囲が一定なら、無理して開く事なかったです(^^;; 勉強になりました。 ｂｙ ｗｋｊ
なるほど・・ファイルを開かず作業もできるのですかぁ。勉強になりますぅ。 ファイル名は、最初は同一で テスト仕様書_○○.xlsと ○だけは分野別に分かれています。 これもまた、何層もフォルダになっていたり、１フォルダの中に裸のまま保存してあったりとまちまちなので(;´Д`A 明日早速、改訂してみます♪
'①FD0001-テスト仕様書-分野名 を開き、ケース数を抽出する。 Workbooks.Open "X:\○○\10.○○\01.○○\040.製造テスト\03.テスト結果報告書\01.画面\03.○○\03.02.○○\○○\FD0001-テスト仕様書-S030212001（分野名）.xls"
ActiveSheet.Name = "テストケース"
Range("T6:T100").Select ←共有の固定なる表のT列に数値があるのでT6以降からという意味で
Selection.Copy
Windows("テスト仕様書_テストケース数集計.xls").Activate ←自作の合計のみをペーストしたい表
Sheets("01.画面").Select
Range("L3").PasteSpecial Paste:=xlPasteValues ←印刷範囲外にSUM関数の列を作り、そこへペースト
Range("L2").Copy ←SUMの合計数
Range("H21").PasteSpecial Paste:=xlPasteValues ←ファイル名別のセル
Range("L3:L1000").Clear
'FD0001-テスト仕様書-S030212001-分野名 を開き、行数を抽出する。
Windows("FD0001-テスト仕様書-S030212001-○○.xls").Activate
ActiveSheet.Name = "テストケース"
Range("I6").Select ←表中で空白以外の行数の数値を抽出したい列
Range(Selection, Selection.End(xlDown)).Select *これですと空白の手前でとまってしまうの今朝気がつきました・・・
Selection.Copy
Windows("テスト仕様書_テストケース数集計.xls").Activate
Sheets("01.画面").Select
Range("M3").PasteSpecial Paste:=xlPasteValues ←M列に=COUNTA関数にしました
Range("M2").Copy
Range("G21").PasteSpecial Paste:=xlPasteValues
Range("M2:L1000").Clear
Windows("FD0001-単体テスト仕様書-S030212001-分野名.xls").Activate
ActiveWorkbook.Close
こんな感じで作っていました。 ｗｋｊさんに少し近い形なのでしょうかぁ。
厄介なことに、このやり方だと ファイルが増えたり減ったりして 自作した集計の表を行挿入したりしたら 全てのセル位置のマクロを修正しなければならないんですよねぇ・・・（泣）
>> myTotal = ExecuteExcle4Macro("sum(" & myRange & ")")
seiyaさんの元で試してみたのですがぁ、ここで定義が違うということでとまってしまうのですが、『ExecuteExcle4Macro』ってどういう意味なのでしょうかぁ・・。
Hummm 私自身は検証できないので... myRange = .... を
myFormula = "sum('" & myDir & "[" & fn & "]" & sn & "'!R6C20:R100C20)"
myTotla = ExecuteExcel4Macro("sum("....) を
myTotal = ExecuteExcel4Macro(myFormula)
に変更してみてください。 (seiya)
Ｄドライブの\test配下に存在する全てのEXCELファイルを処理対象とします。 集計結果を集計.xlsのA1（T列の合計値）,B1（I列の個数）に格納します。 また、集計対象はT列I列の全てにしてます。（範囲指定できるかどうかが不明のため）
Sub test()
Dim myDir, fullpath, fn As String Dim gokei, kosu As Long
myDir = "D:\test\"
gokei = 0
kosu = 0
fn = Dir(myDir & "*.xls")
'If fn = "" Then Exit Sub
Do While fn <> ""
fullpath = myDir + fn
Workbooks.Open fullpath 'ブックのOPEN
With Workbooks(fn)
.Activate
.Worksheets("Sheet1").Activate
.Worksheets("Sheet1").Range("A1").Activate
ActiveCell.FormulaR1C1 = "=SUM(C[19])" 'SUM関数を使ってＴ列全ての数値を集計
gokei = gokei + ActiveCell.Range("A1").Value 'gokeiにSUMした数値を保存
.Worksheets("Sheet1").Range("B1").Activate
ActiveCell.FormulaR1C1 = "=counta(C[7])" 'COUNTA関数を使ってＩ列全ての数値を集計
kosu = kosu + ActiveCell.Range("B1").Value
ActiveWorkbook.Saved = True 'ブックの変更をセーブしない
ActiveWorkbook.Close 'ブックを閉じる
fn = Dir
End With
Loop
Total:
Workbooks("集計.xls").Activate '合計数を格納するブック・シートを選択
Workbooks("集計.xls").Worksheets("Sheet1").Activate '合計数を格納するブック・シートを選択
Range("A1").Select
Range("A1").Value = gokei '合計した結果をA1に格納
Range("B1").Value = kosu '合計した個数をB1に格納
End Sub
もしかして、ブック毎の合計数と個数が必要でしたでしょうか？（上記例では全てのブックの集計をしてしまう） その場合には、DO...LOOPの中に結果を記述する処理が必要になります。 ちょっとだけ面倒なので、もう少し時間を下さい(^^;;
ｂｙ ｗｋｊ
みのさん、 1) コピーする範囲は各ブックの"Sheet1!T1:T100"ですか？ 2) 貼り付ける位置と、合計を表示する位置関係が不明です。
以上２点が判明すれば、それほど難しくないですよ？ (seiya)
Wkjさん seiyaさん
ありがとうございます。
各ブックの行数と個数はそれぞれ異なっていまして、T6より合計がしたくT100というのは範囲選択に余裕を見積もって選択しているだけなので、実際の表では、セル50行で終わるのもあれば、70行もあります。
>> Range("L3:L1000").Clear
これは、集計用のシートに計算式（CountaやSUM）をいれており、これも1000まで計算範囲としてあけていることを示しています・・。 雑用頼まれ、これから作業に入るところです。 必要な箇所は、共通ブックの表T列に"ケース数"という欄があり、そこに数値が入っています。 数値が入ってないブックに関しては、I列の行数をカウントし、合計を抽出しようという考えでした。
その合計値を別ブックの集計表のファイル名別に数値をコピペしていく感じです。
言葉足らずですみませんでしたぁorz
80ファイル？のコードを変えましたので試してください。 実際の使用に際しては変更が必要ですが... (seiya)
二通り試してみましたぁ。 両方いい感じに動きつつありますぅうう。ありがとですorz あとはうまくT列とI列の6行目より下をカウントできるようになればめちゃくちゃ早く終われそうです(；ω；) 列全体にしてしまうと表の区分名までカウントされちゃいますもんねぇ・・。
完成が楽しみになってきましたぁ♪ (みの)
>T列の6行目より下をカウント...
With .Range("t3",.Range("t" & Rows.Count).End(xlUp))
MsgBox .Rows.Count '<--- これ
.
.
.
End With
(seiya)
seiyaさん、wkjさん やはりフォルダに新規シートが追加されていたので、交渉して集計用に別フォルダを作成し、何層にもなっていたフォルダを最小限に収縮するように言いましたぁ…。 お二方にはとても素晴らしいマクロをご教授していただいて助かりましたぁorz あたしのマクロは単純すぎてお恥ずかしい限りです(笑)
上記のカウント変更してみますぅ^-^
00-01-01テスト計画書(テストケース)-≪テストケース分類≫テストケース：集計ツールV1.2対応
a列 b+c列 d列 e+f+g列 h列 i列 No. 大区分 No. 中区分 No. 小区分 条件 途中経過 不具合票 番号 補足 作成者 実施 予定日 実施日 完了日 承認者 ｹｰｽ数 共1 画面表示 1 画面ヘッダ部 1 2/19 2/19 1 2 2/19 2/19 1 2 画面フッタ部 3 2/19 2/19 1 3 項目配置 4 2/19 2/19 1 4 見出し表示 5 2/19 2/19 1 5 文字表示 6 1 7 2/19 2/19 1
こちらに転記いたします。 あたしの場合は、i列=小区分にあたるcounta数（大区分等は結合になっている*F列ではない）と、t列=ケース数。 追加に途中経過の列(m列)に"終了"となる文字数もカウントしたいですぅ・・。 countif=m:m"終了"とか・・？
コード・ソースは、seiyaさんをベースに使用していたのですがぁ、wkjさんのコード共に選考中です。
Sub 作業()
Dim myDir As String, fn As String, rng As Range, wb As Workbook, txt
myDir = "C:\Documents and Settings\テスト仕様書\"
fn = Dir(myDir & "*テスト仕様書*.xls")
If fn = "" Then Exit Sub
Do While fn <> ""
Set wb = Workbooks.Open(myDir & fn)
With wb.Sheets("*テストケース*")
With .Range("t3",.Range("t" & Rows.Count).End(xlUp))
ThisWorkbook.Sheets(1).Range("a" & Rows.Count).End(xlUp).Offset(2).Resize(.Rows.Count).Value = .Value
txt = Join$(Array("Sum('",myDir,"[",fn,"]","*テストケース*'!",.Address,")"),vbNullString)
End With
End With
wb.Close False
fn = Dir
Loop
End Sub
こんな感じです。 始めは合計のみで構わないと言われていたのですが、ぽんぞうさんのスレに書かれていたやり方ですと個別に数が一目でわかるので便利そうだと思い、こちらに変更したいと思いましたぁ・・。 （みの）
>>> 1) 各項目も列名は？ 2) 結合はどのように？(列？行？） 3) 上記のデータで結果はどのように？ 表が崩れてしまったので、i列までしか記入していませんが、i列以降は1列に対して使用。結合されているのは、列の大区分と中区分です。 あたしも結果を別ファイルに転記したく、フォーマットは作成中ですぅ。 ファイル名も転記されるということなので、 リスト名 ケース数 行数(ケースなし) 合格件数 FD0001-単体テスト仕様書-S030171001(見積依頼）.xls 0 0 0 FD0001-単体テスト仕様書-S030171002(見積依頼明細）.xls 0 0 0 FD0001-単体テスト仕様書-S030172001(見積回答）.xls 0 0 0 FD0001-単体テスト仕様書-S030172002(見積回答明細）.xls 0 0 0 FD0001-単体テスト仕様書-S030212001（手配計画リリース）.xls 0 0 0 FD0001-単体テスト仕様書-S030214001（発注依頼一覧）.xls 0 0 0
こんな感じに結果を出していこうと考え中です。
1) 各項目も列名は？ 2) 結合はどのように？(列？行？） 3) 上記のデータで結果はどのように？ (seiya)
ケース数 行数(ケースなし) 合計件数
の計算式/条件がわかりません。 (seiya)
>>seiyaさん ケース数=数字の計算(SUM) 行数(ケースなし)=文字列のカウント(COUNTA?<>は含まない) 合格件数="途中経過"列の"終了"の個数(countif(K:K"終了"?)) ですぅ。 （みの）
文字数のカウントはどの列？ COUNTA?<>は含まない って？ (seiya)
みのさん、
ちょっと耳が痛いかもしれませんが読んでください。
今まで提示したコードが全て無駄になっていることはわかりますか？ みのさんが質問したいことを十分に精査せずに事を運んでいるからです。
何が問題で、何をどうしたい。
が判明すれば、その時点で99.9%解決しているのです。
>コードソースはseiyaさんの... 残念ながら、みのさんにはできません。
今日はここで落ちますのでよく考えて他の人に問題が通じるようにもう一度整理してみてください。
(seiya)
初心者ではないの？コードやVBA用語知らない人は仕方ないと思いますよ。 頭ごなしにあなたにはできないというのは..残酷なのでは。 wkjさんのように一行ずつ説明を加えてあげたら理解できたのではないでしょうか..。 確かに説明不足とご本人も言われてる通り、どうしたいのか他の方には通じないですが。 I列の小区分が行数で、<>とは空白以外という意味だとお察ししてみましたがいかがでしょう？ちなみに空白は=ですが。 ケース数とは、T列の合計値ですかね。 どうもT列・I列に手こずっているのではないでしょうか。頻繁にT列..ってでてきますし。 見る限りでは、他のコードには問題なさそうですよね。
Sub 作業()
Dim myDir As String, fn As String, rng As Range, wb As Workbook, txt
myDir = "C:\Documents and Settings\テスト仕様書\"
fn = Dir(myDir & "*テスト仕様書*.xls")
If fn = "" Then Exit Sub
Do While fn <> ""
Set wb = Workbooks.Open(myDir & fn)
With wb.Sheets("*テストケース*")
With .Range("t3",.Range("t" & Rows.Count).End(xlUp)) 'ここと
ThisWorkbook.Sheets(1).Range("a" & Rows.Count).End(xlUp).Offset(2).Resize(.Rows.Count).Value = .Value 'ここ
txt = Join$(Array("Sum('",myDir,"[",fn,"]","*テストケース*'!",.Address,")"),vbNullString)
End With
End With
wb.Close False
fn = Dir
Loop
End Sub
ここを見直せばいいのかと。試してみますのでお待ちを..。
私も最初の頃は、どう説明してよいかわかりませんでした。
dim?offset?どれがどれに当てはまるのかなんのこっちゃとさっぱりで。
昨日から気になってたけど、気持ちよく掲示板を利用したいですよね。
（さとちー)
さとちーさん、 あなたは、ここまでの道のりをわかっていない。 このスレのほかに、みのさんが割り込んできたスレを参考にすれば もう既に自己解決していなければならない（ご本人にその力があれば）
みのさんの問題の解決策はこのスレの当初のものとは違っている。
コードを書く以前の問題で、「何が問題でどのように解決したい」が 具体的に理解できて無いとコードなどかけないと思いますが？ みのさんが、私に理解できるように問題を整理して説明してくれれば 責任を持って解決します。 (seiya)
seiyaさん。 確かに初歩からの流れは私は存じていませんが、昨日のレスだと使用変更する理由だけではないのでしょうか..？ ぽんぞうさんのコードを利用して再度修正したいのですよね。 みのさんは流れは分かっていても、どこの数式・コードを修正するべき箇所かを分かっておられないだけなのではないでしょうか..。 途中からの身で申し訳ありません。 来づらいかと思われますが、ご覧になられてたらご本人のご訪問お待ちします..。
私的の観点では、 T列6行目～のケース数値、数値がない時はI列空白以外の文字行数、K列の途中経過欄の『終了』文字数 を知りたいのではと察してます。どうでしょうか。 分からない場合は、はっきりと分からないといわれたほうがアドバイスしやすいですけどね..。 (さとちー)
>みのさんは流れは分かっていても、どこの数式・コードを修正..... だから無理だと言っているのです。
ここで大事なことは（すべての質問者に共通）
何を、どうしたいのか を具体的に説明する努力を惜しんでは いけないということなんですよ。
説明のしすぎは無いのです。
とにかく、あなたとこの件で議論するつもりはありません。 みのさんに"あなたのコード"を提示すべきでしょう。 (seiya)
Sub test2()
Dim myDir As String, fn As String, wb As Workbook, ws As Worksheet, a(), n As Long
myDir = "C:\Documents and Settings\デスクトップ\単体テスト仕様書（集計用）\"
fn = Dir(myDir & "*単体テスト仕様書*.xls") '共通ブック
ReDim a(1 To Rows.Count, 1 To 3)
a(1, 1) = "処理対象ブックリスト" '全ブックリスト
a(1, 2) = "個数": a(1, 3) = "行数" 'ケース数とI列の行カウント数
n = 1
Do While fn <> ""
Set wb = Workbooks.Open(myDir & fn)
For Each ws In wb.Sheets
If ws.Name Like "*テストケース*" Then '共通シート名のみ抽出
n = n + 1
With ws.Range("h3", ws.Range("h" & Rows.Count).End(xlUp)) 'ケース数について [t -> h に変更]
a(n, 1) = fn 'ブック名について ↓ 6 -> 12
a(n, 2) = IIf(Application.Count(.Offset(, 12)) > 0, Application.Sum(.Offset(, 12)), 0) 'ケース数について ↓6 -> -1に変更
a(n, 3) = IIf(a(n, 2) = 0, Application.CountA(.Offset(, -1)), "") '行数について "i" -> ""に変更, 6 -> -1 に変更
End With
End If
Next
wb.Close False
fn = Dir()
Loop
ThisWorkbook.Sheets(1).Range("a1").Resize(n, 3).Value = a
End Sub
seiyaさん さとちーさん ご報告遅れましてすみません。 朝からあたしも自分なりに理解しようと悩んで考えていましたぁ。 どう説明してよいか言葉が見つからなくご迷惑をおかけしました…。 皆さんのおっしゃるとおりで、あたしには不向きな業種なのかも知れません。 今回のことで、職種を変えようと思っております。 ですが、任された仕事なので投げ出すわけにはいかないのでこれだけは解決したく思ってます。 いろいろ試してみたりとしてましたが、どうしても行数とケース数の数値が計算されません。どこのコードがどの部分にあたるのか自分なりに書き込んではいますがぁ、Offsetの数式を変更しなければならないのでしょうか。 区分名等は５行目。以下６行目からの数値が知りたい。
幾度となく質問申し訳ありませんでしたぁ…。 （みの）
みのさん、いろいろ言いましたが悪気があって言ったわけでは ありませんので、ご考慮ください。 あなたがどのような職種に就いているか知りませんが、私の投稿で 職を変えるようなことは無いように願っています。
私の最後の質問がそのままですので、お答えください。
(seiya)
みのさん、 みのさんの提示されたコードを変更しました。 私なりの理解で変更しましたので、不具合がありましたらお知らせ下さい。 (seiya)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.