Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
9718 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【25749】複数のブックのデータをひとつにまとめた... KOTARO 05/6/13(月) 15:51 質問[未読]
【25750】Re:複数のブックのデータをひとつにまとめ... だるま 05/6/13(月) 17:02 回答[未読]
【25756】Re:複数のブックのデータをひとつにまとめ... KOTARO 05/6/13(月) 19:21 発言[未読]
【25757】Re:複数のブックのデータをひとつにまとめ... だるま 05/6/13(月) 19:48 回答[未読]
【25758】Re:複数のブックのデータをひとつにまとめ... KOTARO 05/6/13(月) 20:24 発言[未読]
【25760】Re:複数のブックのデータをひとつにまとめ... だるま 05/6/13(月) 20:40 回答[未読]
【25761】Re:複数のブックのデータをひとつにまとめ... KOTARO 05/6/13(月) 21:11 発言[未読]
【25762】Re:複数のブックのデータをひとつにまとめ... だるま 05/6/13(月) 21:26 回答[未読]
【25765】Re:複数のブックのデータをひとつにまとめ... KOTARO 05/6/13(月) 22:16 発言[未読]
【25777】Re:複数のブックのデータをひとつにまとめ... だるま 05/6/14(火) 11:17 回答[未読]
【25783】Re:複数のブックのデータをひとつにまと... KOTARO 05/6/14(火) 17:35 発言[未読]
【25788】Re:複数のブックのデータをひとつにまと... だるま 05/6/14(火) 19:47 回答[未読]
【25805】Re:複数のブックのデータをひとつにまと... KOTARO 05/6/15(水) 9:19 発言[未読]
【25807】Re:複数のブックのデータをひとつにまと... だるま 05/6/15(水) 11:23 回答[未読]
【25822】Re:複数のブックのデータをひとつにまと... KOTARO 05/6/15(水) 17:10 お礼[未読]
【25749】複数のブックのデータをひとつにまとめた...
質問  KOTARO  - 05/6/13(月) 15:51 -
引用なし
パスワード
   複数のブックのデータをひとつにまとめる作業を効率化したいのです。
・各ブックとも列数は一定ですが、行数はそれぞれ異なります
・各データには空白の列・行がまじります

手順としましては
・BOOK1.xlsのデータをコピー、BOOKA.xls(1行目にヘッダーのみあり)に2行目から
　ペースト
・同様にBOOK2.xlsのデータをコピー、先程ペーストしたBOOK1.xlsのデータの次の
　行にペースト(以下繰り返し)
という具合です。

よろしくお願い致します。
【25750】Re:複数のブックのデータをひとつにまと...
回答  だるま WEB  - 05/6/13(月) 17:02 -
引用なし
パスワード
   こんにちは

こんな感じでしょうか。^d^

Sub Books2Sheet()
　　Dim rngDest As Range
　　Dim myPath As String
　　Dim myBookName As String
　　Dim myBook As Workbook
　　Dim mySheet As Worksheet
　　
　　myPath = ThisWorkbook.Path & "\"
　　
　　myBookName = Dir(myPath & "*.xls")
　　If myBookName = "" Then Exit Sub
　　
　　Set rngDest = Workbooks("BOOKA.xls").Range("A2")
　　
　　Do While Not myBookName = ""
　　　　If myBookName = ThisWorkbook.Name Then
　　　　　　'nop
　　　　Else
　　　　　　Set myBook = Workbooks.Open(myPath & myBookName)
　　　　　　For Each mySheet In myBook.Worksheets
　　　　　　　　With mySheet.UsedRange
　　　　　　　　　　.Copy rngDest
　　　　　　　　　　Set rngDest = rngDest.Offset(.Rows.Count, 0)
　　　　　　　　End With
　　　　　　Next
　　　　　　myBook.Close False
　　　　End If
　　　　myBookName = Dir()
　　Loop
　　　　　　　　
End Sub
【25756】Re:複数のブックのデータをひとつにまと...
発言  KOTARO  - 05/6/13(月) 19:21 -
引用なし
パスワード
   ▼だるま さん：
ありがとうございます。
さっそく実行してみましたが、実際に作業の対象となりますのはBOOKではなく固定長データをエクセル形式に変換したファイルで「A1.prn」「A2.prn」…(例)という名前です。
コードを修正したのですが、以下の部分で終了してしまいます。

>Sub Books2Sheet()
>　　Dim rngDest As Range
>　　Dim myPath As String
>　　Dim myBookName As String
>　　Dim myBook As Workbook
>　　Dim mySheet As Worksheet
>　　
>　　myPath = ThisWorkbook.Path & "\"
>　　
>　　myBookName = Dir(myPath & "*.prn")
>　　If myBookName = "" Then Exit Sub
【25757】Re:複数のブックのデータをひとつにまと...
回答  だるま WEB  - 05/6/13(月) 19:48 -
引用なし
パスワード
   >エクセル形式に変換したファイルで「A1.prn」「A2.prn」
エクセル形式なら「*.xls」じゃないんですか。??

>コードを修正したのですが、以下の部分で終了してしまいます。
>>　　myPath = ThisWorkbook.Path & "\"
>>　　
>>　　myBookName = Dir(myPath & "*.prn")
>>　　If myBookName = "" Then Exit Sub
ここで終わるということはファイルが存在しないということになります。
パスは合っていますか。

でも、たとえパスが合っていてもファイルが「*.prn」(=テキスト形式)なら
提示のコードではぜんぜんだめです。
^d^
【25758】Re:複数のブックのデータをひとつにまと...
発言  KOTARO  - 05/6/13(月) 20:24 -
引用なし
パスワード
   ▼だるま さん：
>>エクセル形式に変換したファイルで「A1.prn」「A2.prn」
>エクセル形式なら「*.xls」じゃないんですか。

すみません。すべてエクセル形式にしました。
こんどは
>Set rngDest = Workbooks("BOOKA.xls").Range("A2")
で「オブジェクトはこのプロパティまたはメソッドをサポートしていません」
と出ました。
【25760】Re:複数のブックのデータをひとつにまと...
回答  だるま WEB  - 05/6/13(月) 20:40 -
引用なし
パスワード
   >こんどは
>>Set rngDest = Workbooks("BOOKA.xls").Range("A2")
>で「オブジェクトはこのプロパティまたはメソッドをサポートしていません」
>と出ました。
失礼しました。

Workbooks("BOOKA.xls").Range("A2")
は
Workbooks("BOOKA.xls").Worksheets(1).Range("A2")
の間違いです。
^d^
【25761】Re:複数のブックのデータをひとつにまと...
発言  KOTARO  - 05/6/13(月) 21:11 -
引用なし
パスワード
   ▼だるま さん：
たびたびすみません。修正しましたがこんどは
Thenの後、End If前までのコードが飛んでしまいます。

If myBookName = ThisWorkbook.Name Then
　　　　　　'nop
　　　　Else
　　　　　　Set myBook = Workbooks.Open(myPath & myBookName)
　　　　　　For Each mySheet In myBook.Worksheets
　　　　　　　　With mySheet.UsedRange
　　　　　　　　　　.Copy rngDest
　　　　　　　　　　Set rngDest = rngDest.Offset(.Rows.Count, 0)
　　　　　　　　End With
　　　　　　Next
　　　　　　myBook.Close False
　　　　End If
【25762】Re:複数のブックのデータをひとつにまと...
回答  だるま WEB  - 05/6/13(月) 21:26 -
引用なし
パスワード
   >たびたびすみません。修正しましたがこんどは
>Thenの後、End If前までのコードが飛んでしまいます。
>
>If myBookName = ThisWorkbook.Name Then
>　　　　　　'nop
>　　　　Else
>　　　　　　Set myBook = Workbooks.Open(myPath & myBookName)
>　　　　　　For Each mySheet In myBook.Worksheets
>　　　　　　　　With mySheet.UsedRange
>　　　　　　　　　　.Copy rngDest
>　　　　　　　　　　Set rngDest = rngDest.Offset(.Rows.Count, 0)
>　　　　　　　　End With
>　　　　　　Next
>　　　　　　myBook.Close False
>　　　　End If
コードが書いてある自ブックは処理しないので飛んで正常です。

ここで気が付きましたがもう一つ修正です。
自ブックの他に「BOOKA.xls」もパスしなければなりませんね。

>If myBookName = ThisWorkbook.Name Then
>　　'nop
>Else
を
If myBookName = ThisWorkbook.Name Then
　　'nop
ElseIf myBookName = "BOOKA.xls" Then
　　'nop
Else
としてください。^d^
【25765】Re:複数のブックのデータをひとつにまと...
発言  KOTARO  - 05/6/13(月) 22:16 -
引用なし
パスワード
   だるま さん

修正しましたが、やはり素通りしてしまいます。
コピーの対象となるBOOKが5つとBOOKAを開いている状態です。
コードはPERSONAL.xls上に書いております。
【25777】Re:複数のブックのデータをひとつにまと...
回答  だるま WEB  - 05/6/14(火) 11:17 -
引用なし
パスワード
   >修正しましたが、やはり素通りしてしまいます。
>コピーの対象となるBOOKが5つとBOOKAを開いている状態です。
コピー元のブックは予め開いておく必要はありません。
ひとつずつ開いてはコピー、閉じるを繰り返しますので。

>コードはPERSONAL.xls上に書いております。
であればパス指定が違っているということですね多分。

>myPath = ThisWorkbook.Path & "\"
を、実際にコピー元データブックが存在するパスに変えてください。
たとえば、
myPath = "C:\Temp\myData\"
のように。
^d^
【25783】Re:複数のブックのデータをひとつにまと...
発言  KOTARO  - 05/6/14(火) 17:35 -
引用なし
パスワード
   だるま さん
お世話になります。

パスを修正し実行したところ、
>Set rngDest = Workbooks("BOOKA.xls").Worksheets("Sheet1").Range("A2")
の箇所で「インデックスが有効範囲にありません」と出ました。
【25788】Re:複数のブックのデータをひとつにまと...
回答  だるま WEB  - 05/6/14(火) 19:47 -
引用なし
パスワード
   >パスを修正し実行したところ、
>>Set rngDest = Workbooks("BOOKA.xls").Worksheets("Sheet1").Range("A2")
>の箇所で「インデックスが有効範囲にありません」と出ました。

このエラーは、指定したコレクションの要素が存在しないということ、つまり
"BOOKA.xls"か"Sheet1"が存在しないということです。

"BOOKA.xls"を開いておいてから実行していますよね。

その中に"Sheet1"シートはありますか。

^d^
【25805】Re:複数のブックのデータをひとつにまと...
発言  KOTARO  - 05/6/15(水) 9:19 -
引用なし
パスワード
   だるま さん

見事に動きました！

実行してみて1点だけ問題があります。
コピー元のA列またはA列B列が空白の場合、その部分が省略されてペーストされ
結果としてコピー先のヘッダーとデータの位置がずれてしまいます。
A列またはA列B列が空白の場合でもその列を含めて(つまり常にA列から)コピーできますでしょうか。
【25807】Re:複数のブックのデータをひとつにまと...
回答  だるま WEB  - 05/6/15(水) 11:23 -
引用なし
パスワード
   >コピー元のA列またはA列B列が空白の場合、その部分が省略されてペーストされ
>結果としてコピー先のヘッダーとデータの位置がずれてしまいます。
>A列またはA列B列が空白の場合でもその列を含めて(つまり常にA列から)コピーできます
>でしょうか。

Dim rngSource As Range
を追加

For Each mySheet In myBook.Worksheets
　　With mySheet.UsedRange
を

For Each mySheet In myBook.Worksheets
　　Set rngSource = mySheet.UsedRange
　　Set rngSource = Intersect _
　　　　(mySheet.Columns("A:J"), rngSource.EntireRow)
　　With rngSource
に変更

でいかがでしょうか。^d^
(A:Jは実際の列記号に置き換えてください。)
【25822】Re:複数のブックのデータをひとつにまと...
お礼  KOTARO  - 05/6/15(水) 17:10 -
引用なし
パスワード
   だるまさん

イメージ通りの動作ができました。
これで作業時間が大幅に短縮され、嬉しいです。
誠にありがとうございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
9718 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free