Excel VBA質問箱 IV

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

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


7743 / 76734 ←次へ | 前へ→

【74576】Re:フォルダ(サブフォルダ含)内ブックのデータ集計について
発言  kanabun  - 13/7/28(日) 21:32 -

引用なし
パスワード
   ▼じゃっかる さん:


>リンク先のコードは 大まかに言って
>
>(1) 対象フォルダの指定
>(2) 指定フォルダ内の(サブフォルダも含めた)ファイルの取得
>(3) 検索されたBookに対する処理
>
>のような形をとっています。そこは分かりますよね。
>
>で、まるごとコピペで動かしてみて、 (1) (2) は何ら問題ないと思います。
>変更するとすれば

>(3)の部分、すなわち
>
>>  'Bookごとの処理
>>  Dim book
>>  Dim ws As Worksheet
>>  
>>  For Each book In FoundFiles
>>    With Workbooks.Open(book)
>>      On Error Resume Next
>>      Set ws = .Worksheets("表紙")
>>      On Error GoTo 0
>>      If ws Is Nothing Then
>>        MsgBox "このBookには指定シートがありません"
>>      Else
>>        ws.Range("E36").Formula = "=SUM('1:31'!M15)"
>>        Set ws = Nothing
>>      End If
>>      .Close True
>>    End With
>>  Next
>
>の部分かと思います。
>
>ここを、

  'Bookごとの処理
  Dim cnt As Long: cnt = 1
  Dim book
  Dim ws As Worksheet
  
  For Each book In FoundFiles
    With Workbooks.Open(book)
      On Error Resume Next
      Set ws = .Worksheets("1枚目")
      On Error GoTo 0
      If ws Is Nothing Then
        MsgBox "このBookには指定シートがありません"
      Else
        With ThisWorkbook.Sheets(1)
          .Cells(cnt, 1).Value = ws.Range("A1").Value
          .Cells(cnt, 2).Value = ws.Range("A2").Value
        End With
        Set ws = Nothing
      End If
      .Close True
    End With
  Next

と、こうしたらどうなります?

10 hits

【74572】フォルダ(サブフォルダ含)内ブックのデータ集計について じゃっかる 13/7/28(日) 16:18 質問
【74573】Re:フォルダ(サブフォルダ含)内ブックの... kanabun 13/7/28(日) 18:41 発言
【74574】Re:フォルダ(サブフォルダ含)内ブックの... じゃっかる 13/7/28(日) 20:31 発言
【74575】Re:フォルダ(サブフォルダ含)内ブックの... kanabun 13/7/28(日) 21:22 発言
【74576】Re:フォルダ(サブフォルダ含)内ブックの... kanabun 13/7/28(日) 21:32 発言
【74577】Re:フォルダ(サブフォルダ含)内ブックの... kanabun 13/7/28(日) 22:43 発言
【74578】Re:フォルダ(サブフォルダ含)内ブックの... じゃっかる 13/7/29(月) 10:55 質問
【74579】Re:フォルダ(サブフォルダ含)内ブックの... kanabun 13/7/29(月) 12:17 発言
【74580】Re:フォルダ(サブフォルダ含)内ブックの... じゃっかる 13/7/29(月) 14:48 お礼

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