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