Excel VBA質問箱 IV

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

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


8318 / 13644 ツリー ←次へ | 前へ→

【33978】複数ファイルのSheetの内容を新しいファイルの1つのSheetに結合したい 初級++ 06/1/24(火) 15:28 質問[未読]
【33982】Re:複数ファイルのSheetの内容を新しいファ... inoue 06/1/24(火) 15:54 発言[未読]
【33986】Re:複数ファイルのSheetの内容を新しいファ... 初級++ 06/1/24(火) 16:29 発言[未読]
【33994】Re:複数ファイルのSheetの内容を新しいファ... inoue 06/1/24(火) 18:47 発言[未読]
【34005】Re:複数ファイルのSheetの内容を新しいファ... 初級++ 06/1/24(火) 21:10 お礼[未読]
【34031】Re:複数ファイルのSheetの内容を新しいファ... 初級++ 06/1/25(水) 11:55 質問[未読]
【34037】Re:複数ファイルのSheetの内容を新しいファ... inoue 06/1/25(水) 14:10 発言[未読]
【34058】Re:複数ファイルのSheetの内容を新しいファ... 初級++ 06/1/25(水) 17:52 お礼[未読]

【33978】複数ファイルのSheetの内容を新しいファ...
質問  初級++  - 06/1/24(火) 15:28 -

引用なし
パスワード
   超初心者でございます。
題名の通りなのですが、1シートしかもたない複数(いくつかはその時々で変わります)の.xlsのファイルがあるのですが、これらのシートの内容を新しいファイルの1つのシートに結合する方法をどなたかご教授をお願いします。

1つのファイルにシートごとコピーして、複数シートを持つ状態にする方法はわかったのですが、これが特殊な例なのか調べてもわかりませんでした。

よろしくお願い致します。

【33982】Re:複数ファイルのSheetの内容を新しいフ...
発言  inoue E-MAILWEB  - 06/1/24(火) 15:54 -

引用なし
パスワード
   >1つのファイルにシートごとコピーして、
>複数シートを持つ状態にする方法はわかったのですが、
>これが特殊な例なのか調べてもわかりませんでした。
「特殊な例」って何ですか?
分かったのならそのコードを工夫されれば良いのでしょうが、
何が問題なのですか?

以下のことは分かるのでしょうか。
1.複数の.xlsを順次開く方法
2.1つのファイルへのコピー方法
3.開いた「元」.xlsの閉じ方

【33986】Re:複数ファイルのSheetの内容を新しいフ...
発言  初級++  - 06/1/24(火) 16:29 -

引用なし
パスワード
   inoue さん返信有り難うございます。
このマクロの実行方法として、元ファイルとマクロファイルを開き、マクロファイルのリストボックスにそれらを表示して、使用者に結合するファイルを選択してもらうつもりです。
また、元ファイルの名前の先頭には1.、2.など結合する順番に数字を割り振る予定でいます。
情報が後出しとなり申し訳ありません。

不明な点としましては下記の2点となります。

・1.、2.などの数字を元に結合する順番を判定する方法
・inoue さんが挙げられた「2.1つのファイルへのコピー方法」

よろしくお願いします。

【33994】Re:複数ファイルのSheetの内容を新しいフ...
発言  inoue E-MAILWEB  - 06/1/24(火) 18:47 -

引用なし
パスワード
   >マクロファイルのリストボックスにそれらを表示して、
>使用者に結合するファイルを選択してもらうつもりです。
いまいち不明点が残りますが。

>不明な点としましては下記の2点となります。
>・1.、2.などの数字を元に結合する順番を判定する方法
リストボックスから選択した順序は取り出せないと思います。
参照する.xlsが1フォルダにあるなら、
GetOpenFilenameメソッドでMultiSelectをTrueにすれば、
「開く」ダイアログが表示されて複数ファイルの指定が可能です。
この時は選択順で配列になって受け取れると思います。

>・inoue さんが挙げられた「2.1つのファイルへのコピー方法」
最初のファイルと2番目以降で処理が異なります。
・最初のファイルの場合は宛先なしでCopyします。
 これで新規ブックが作られますから、
 このブック(Object)を変数に確保し、シートカウントを「1」にします。
 [例]
 ActiveSheet.Copy
 Set objWbk = ActiveWorkbook
 cntSheet = 1

・2番目以降の.xlsは1番目で作った新規ブックにシート追加します。
 [例]
 ActiveSheet.Copy After:=objWbk.Worksheets(cntSheet)
 cntSheet = cntSheet + 1

【34005】Re:複数ファイルのSheetの内容を新しいフ...
お礼  初級++  - 06/1/24(火) 21:10 -

引用なし
パスワード
   inoue さん、大変ご親切なお答え有り難う御座います。
おかげさまで、期待通りの動作を行うマクロを作成することができました。

inoue さんのおっしゃるとおりListBoxを使わず作成したため、ソースも大変シンプルなものとすることができました。

本当に有り難う御座います!

【34031】Re:複数ファイルのSheetの内容を新しいフ...
質問  初級++  - 06/1/25(水) 11:55 -

引用なし
パスワード
   大変申し訳ありませんが、もう一つ解決できない問題がでてきました。

Sub Combination_Start()

  Dim BaseFile    As String
  Dim vntFileName   As Variant
  Dim vntGetFileName As Variant
  Dim BaseWB     As Workbook   '元となるファイル
  Dim CopyWB     As Workbook  

  '元となる1.のファイルを1つだけを選択します
  BaseFile = Application.GetOpenFilename(filefilter:="Excel(*.xls),*.xls", Title:="1.のファイルを選択")
  If BaseFile = "False" Then
    Exit Sub
  End If
  
  '1.以外のファイルを開くダイアログを開きます
  vntFileName = Application.GetOpenFilename( _
       filefilter:="Excel(*.xls),*.xls" _
      , FilterIndex:=1 _
      , Title:="結合するファイルを1.以外すべて選択" _
      , MultiSelect:=True _
      )
  
  'BaseWBに1.ファイルを格納
  Set BaseWB = Workbooks.Open(Filename:=BaseFile, ReadOnly:=True)

  '2.以降のファイルを開き、1.BaseWBに追加していきます
  If IsArray(vntFileName) Then
    For Each vntGetFileName In vntFileName

      Workbooks.Open vntGetFileName
      Set CopyWB = ActiveWorkbook
      CopyWB.Worksheets(1).UsedRange.Copy _
      BaseWB.Worksheets(1).Range("A" & Sheet1.Rows.Count).End(xlUp).Offset(1)
            
    Next
  End If

  '全て結合したファイルの名前を:Test1.xlsとして保存します。
  BaseWB.SaveAs Filename:="Test1.xls"
  
  For Each WB In Workbooks
    If ThisWorkbook.Name <> WB.Name Then
      WB.Close False
    End If
  Next WB
  
  Set CopyWB = Nothing
  Set BaseWB = Nothing
  Set WB = Nothing
  
  Application.ScreenUpdating = True

End Sub

これが今回作成したマクロです。ただ2.以降のファイルを1.のファイルにコピーして追加することはできたのですが、追加する順番が想定したとおりになりません。
具体的には4つのファイルを結合する場合、1.2.3.4.となってほしいのですが、1.4.2.3.の順番になってしまいます。

どなたか解決法をご教授ください。お願いします。

【34037】Re:複数ファイルのSheetの内容を新しいフ...
発言  inoue E-MAILWEB  - 06/1/25(水) 14:10 -

引用なし
パスワード
   >2.以降のファイルを1.のファイルにコピーして追加することはできたのですが、
>追加する順番が想定したとおりになりません。
>具体的には4つのファイルを結合する場合、1.2.3.4.となってほしいのですが、
>1.4.2.3.の順番になってしまいます。
例えば、以下のようなサンプルを作ってみましたが、
配列は「選択した順」になりますよ。
Sub TEST()
Dim tblF, IX
tblF = Application.GetOpenFilename("(*.*),*.*", MultiSelect:=True)
For IX = LBound(tblF) To UBound(tblF)
  Debug.Print tblF(IX)
Next
End Sub

2番目以降はCtrlを押しながら1つずつ選択してみて下さい。
(多いと面倒ですが)

【34058】Re:複数ファイルのSheetの内容を新しいフ...
お礼  初級++  - 06/1/25(水) 17:52 -

引用なし
パスワード
   inoue さん、おかげさまで解決することができました。
何度もお手数をおかけして申し訳ありません。
大変勉強になりました。
本当に有り難うございました。

8318 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free