Excel VBA質問箱 IV

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

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


6120 / 13645 ツリー ←次へ | 前へ→

【47074】For Each〜In〜Nextのマクロエラーについて ボボ 07/2/28(水) 13:03 質問[未読]
【47075】Re:For Each〜In〜Nextのマクロエラーにつ... りん@通りすがり 07/2/28(水) 13:06 回答[未読]
【47076】Re:For Each〜In〜Nextのマクロエラーにつ... ボボ 07/2/28(水) 13:12 質問[未読]
【47077】Re:For Each〜In〜Nextのマクロエラーにつ... Blue 07/2/28(水) 13:18 発言[未読]
【47079】Re:For Each〜In〜Nextのマクロエラーにつ... Blue 07/2/28(水) 13:34 発言[未読]
【47080】Re:For Each〜In〜Nextのマクロエラーにつ... ボボ 07/2/28(水) 13:47 お礼[未読]
【47083】Re:For Each〜In〜Nextのマクロエラーにつ... ボボ 07/2/28(水) 14:41 質問[未読]
【47085】Re:For Each〜In〜Nextのマクロエラーにつ... Blue 07/2/28(水) 14:55 質問[未読]
【47086】Re:For Each〜In〜Nextのマクロエラーにつ... ボボ 07/2/28(水) 15:21 質問[未読]
【47087】Re:For Each〜In〜Nextのマクロエラーにつ... Blue 07/2/28(水) 15:29 質問[未読]
【47088】Re:For Each〜In〜Nextのマクロエラーにつ... ボボ 07/2/28(水) 15:44 質問[未読]
【47089】Re:For Each〜In〜Nextのマクロエラーにつ... Blue 07/2/28(水) 16:08 発言[未読]
【47090】Re:For Each〜In〜Nextのマクロエラーにつ... ボボ 07/2/28(水) 16:18 質問[未読]
【47091】Re:For Each〜In〜Nextのマクロエラーにつ... Blue 07/2/28(水) 16:38 発言[未読]
【47092】Re:For Each〜In〜Nextのマクロエラーにつ... ボボ 07/2/28(水) 16:41 お礼[未読]

【47074】For Each〜In〜Nextのマクロエラーについ...
質問  ボボ  - 07/2/28(水) 13:03 -

引用なし
パスワード
   「ファイルを開く」ダイアログを表示させ、そのファイルから、「マクロ.xls」(マクロが保存してあるファイル)の[データ]シートへコピーペーストするというマクロですが、以下のように作成すると、開いたファイルを見に行ってくれません。
どのように記述したらよいのでしょうか?
ちなみに、「OpenFileName」ではなく、ファイルを指定すると、以下のマクロでも正常に実行されるのですが。。。


---------------------------------------
Sub マクロA()
Dim WB1 As Object, WB2 As Workbook
Dim R As Variant

Application.ScreenUpdating = False

  OpenFileName = Application.GetOpenFilename("すべてのファイル,*.*")
  If OpenFileName <> False Then
     Workbooks.Open OpenFileName
  Else
    End
  End If
  
Set WB1 = Workbooks("マクロ.xls").Sheets("データ")
Set WB2 = Workbooks(Dir(OpenFileName))

For Each R In WB1.Range("B3:H3")
  On Error Resume Next
  WB2.Sheets(R.Text).Range("AD20:AD22").Copy
  R.Offset(1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
  WB2.Sheets(R.Text).Range("F37").Copy
  R.Offset(4).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
  WB2.Sheets(R.Text).Range("AF6").Copy
  R.Offset(5).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
 
  If Err.Number <> 0 Then
   MsgBox "指定のシートはありません"
   GoTo 999
  End If
Next

999:
On Error GoTo 0
Err.Clear
Set WB1 = Nothing
Set WB2 = Nothing

Application.CutCopyMode = False


End Sub
---------------------------------------

【47075】Re:For Each〜In〜Nextのマクロエラーに...
回答  りん@通りすがり E-MAIL  - 07/2/28(水) 13:06 -

引用なし
パスワード
   ボボ さん、こんにちわ。
>「ファイルを開く」ダイアログを表示させ、そのファイルから、「マクロ.xls」(マクロが保存してあるファイル)の[データ]シートへコピーペーストするというマクロですが、以下のように作成すると、開いたファイルを見に行ってくれません。
>どのように記述したらよいのでしょうか?
>ちなみに、「OpenFileName」ではなく、ファイルを指定すると、以下のマクロでも正常に実行されるのですが。。。

>---------------------------------------
>Sub マクロA()
>Dim WB1 As Object, WB2 As Workbook
>Dim R As Variant
>
>Application.ScreenUpdating = False
>
>  OpenFileName = Application.GetOpenFilename("すべてのファイル,*.*")
>  If OpenFileName <> False Then
'ここでセットする
     Set WB2 = Workbooks.Open(OpenFileName)
>  Else
>    End
>  End If
>  
>Set WB1 = Workbooks("マクロ.xls").Sheets("データ")
>
<<<略>>>

こんな感じです

【47076】Re:For Each〜In〜Nextのマクロエラーに...
質問  ボボ  - 07/2/28(水) 13:12 -

引用なし
パスワード
   ▼りん@通りすがり さん:
早速ありがとうございます。

教えていただいたように実行してみましたが、
MsgBox "指定のシートはありません"に進んでしまいます。
シートはあるのですが・・・。

【47077】Re:For Each〜In〜Nextのマクロエラーに...
発言  Blue  - 07/2/28(水) 13:18 -

引用なし
パスワード
   とりあえず、どこでエラーになっているのか特定するためにも
>On Error Resume Next
をコメントアウトしてみては。

それと、
>WB2.Sheets(R.Text)
が複数回あるので、Bookオブジェクトを格納したのと同様に

Dim WS As Object ' 本当は Worksheet のほうがよさそう

Set WS = WB2.Sheets(R.Text)

と変数WSに入れてから

WS.Range("AD20:AD22").Copy

のように変更してみては。

【47079】Re:For Each〜In〜Nextのマクロエラーに...
発言  Blue  - 07/2/28(水) 13:34 -

引用なし
パスワード
   ちょっちまとめてみた。
環境がないので動く保証はないです。

Sub マクロA()
  Dim destSheet As Worksheet
  Dim srcBook  As Workbook
  Dim srcSheet As Worksheet
  Dim r As Range
  Dim fileName As Variant
  
  ' コピー元のファイル名の取得
  fileName = Application.GetOpenFilename("すべてのファイル,*.*")
  If fileName <> False Then
     Set srcBook = Workbooks.Open(fileName)
  Else
    Exit Sub
  End If
  
  ' コピー先のシートを設定
  Set destBook = Workbooks("マクロ.xls").Sheets("データ")
  
  ' コピー
  For Each r In destSheet.Range("B3:H3")
    On Error Resume Next
    Set srcSheet = srcBook.Worksheets(r.Text)
    If Err.Number <> 0 Then
      MsgBox "'" & r.Text & "'というシートが存在しません。"
      Exit For
    End If
    On Error GoTo 0
    
    srcSheet.Range("AD20:AD22").Copy
    r.Offset(1).PasteSpecial xlPasteValues
    
    srcSheet.Range("F37").Copy
    r.Offset(4).PasteSpecial xlPasteValues
 
    srcSheet.Range("AF6").Copy
    r.Offset(5).PasteSpecial xlPasteValues
  Next

  Set destSheet = Nothing
  Set srcBook = Nothing
  Set srcSheet = Nothing
  
  Application.CutCopyMode = False
End Sub

【47080】Re:For Each〜In〜Nextのマクロエラーに...
お礼  ボボ  - 07/2/28(水) 13:47 -

引用なし
パスワード
   ▼Blue さん:
ありがとうございます。
早速ためしてみまして、うまく実行できました!

感謝、感謝です。

これにIf文をつけていきたいと思っているのですが、またつまづきそうです。。。
その際は、また書き込みさせていただきますのでよろしくお願いします!

【47083】Re:For Each〜In〜Nextのマクロエラーに...
質問  ボボ  - 07/2/28(水) 14:41 -

引用なし
パスワード
   ▼Blue さん:
先ほどはありがとうございました。
やっぱりつまづいてしまいました。
開いたファイル名が「マクロ.xls」の[データ]シートのセル「B12:H12」と同じであれば処理を進め、違う場合は開いたファイルを閉じ、また新たにファイルを開き、処理を進めるというマクロにしたいのですが、For Each〜とかIf
〜をどのように使ったらいいのか???です。

もしお分かりのようでしたら、教えてください!お願いします!

---------------------------------

Sub マクロ()
  Dim destSheet As Worksheet
  Dim srcBook  As Workbook
  Dim srcSheet As Worksheet
  Dim r As Range
  Dim s As Variant
  Dim fileName As Variant
 
  ' コピー元のファイル名の取得
  fileName = Application.GetOpenFilename("すべてのファイル,*.*")
  If fileName <> False Then
     Set srcBook = Workbooks.Open(fileName)
  Else
    Exit Sub
  End If
 
  ' コピー先のシートを設定
  Set destSheet = Workbooks("マクロ.xls").Sheets("データ")

  ’ここからが???  
  For Each s In destSheet.Range("B12:H12")
    If srcBook.Name = s Then
               ’↑ここの記述がよく分かりません???

     ' コピー
     For Each r In destSheet.Range("B3:H3")
       On Error Resume Next
       Set srcSheet = srcBook.Worksheets(r.Text)
       If Err.Number <> 0 Then
         MsgBox "'" & r.Text & "'というシートが存在しません。"
         Exit For
       End If
       On Error GoTo 0
     
       srcSheet.Range("AD20:AD22").Copy
       r.Offset(1).PasteSpecial xlPasteValues
     
       srcSheet.Range("F37").Copy
       r.Offset(4).PasteSpecial xlPasteValues
    
       srcSheet.Range("AF6").Copy
       r.Offset(5).PasteSpecial xlPasteValues
     Next
       Else
       srcBook.Close
         
     ' コピー元のファイル名の取得
     fileName = Application.GetOpenFilename("すべてのファイル,*.*")
     If fileName <> False Then
        Set srcBook = Workbooks.Open(fileName)
     Else
       Exit Sub
     End If
    
    End If

  Next
  
  Set destSheet = Nothing
  Set srcBook = Nothing
  Set srcSheet = Nothing
 
  Application.CutCopyMode = False
End Sub

---------------------------------

【47085】Re:For Each〜In〜Nextのマクロエラーに...
質問  Blue  - 07/2/28(水) 14:55 -

引用なし
パスワード
   よくわかんないですけど、

シート名

ではなく

ファイル名

になるのでしょうか?

となると
>fileName = Application.GetOpenFilename("すべてのファイル,*.*")
の処理は意味ないような。


それとも、ファイルがあるフォルダを選択させるとか?


また、ファイルである場合、どのシートのデータを引っ張ってくるのでしょうか?

【47086】Re:For Each〜In〜Nextのマクロエラーに...
質問  ボボ  - 07/2/28(水) 15:21 -

引用なし
パスワード
   ▼Blue さん:
すみません、わかりにくくて。。。

やりたいことはこういうことなんですが・・・
↓↓↓
もし、「マクロ.xls」の[データ]シートのセル「B12」の文字列が、開いたファイルのファイル名と同じであれば、その開いたファイルから、「マクロ.xls」の[データ]シートのセル「B3」と同じ名前のシートを探し、そのシートからデータを「マクロ.xls」の[データ]シートにコピーペーストする。ファイル名が違っていた場合は、そのファイルを閉じて、「ファイルを開く」ダイアログボックスから別のファイルを選択し、最初に戻る。これをH列まで繰り返し行いたいのです。。。

さらに分かりづらいでしょうか???

よろしくお願いします!

【47087】Re:For Each〜In〜Nextのマクロエラーに...
質問  Blue  - 07/2/28(水) 15:29 -

引用なし
パスワード
   なんとなくわかったかも。

・B12〜H12
ファイル名が入っている。
(フルパスではないのですよね?)

・B3〜H3
シート名が入っている。


で、ファイル名がB12〜H12ではなかった場合、たとえば

AAAA.xls

と B12 に入っていて、

BBBB.xls

をファイル選択ダイアログで選んだとしても、違うので
AAAA.xlsを選択するまでずーとループするということでしょうか?

【47088】Re:For Each〜In〜Nextのマクロエラーに...
質問  ボボ  - 07/2/28(水) 15:44 -

引用なし
パスワード
   ▼Blue さん:
ありがとうございます!

>・B12〜H12
>ファイル名が入っている。
>(フルパスではないのですよね?)
>・B3〜H3
>シート名が入っている。

はい、その通りです!

>
>で、ファイル名がB12〜H12ではなかった場合、たとえば
>AAAA.xls
>と B12 に入っていて、
>BBBB.xls
>をファイル選択ダイアログで選んだとしても、違うので
>AAAA.xlsを選択するまでずーとループするということでしょうか?

ここがちょっと違いまして・・・

   セル→B12 C12 D12  E12  F12  G12  H12
ファイル名→aaa aaa aaa  bbb  bbb  bbb  bbb

最初に開いたファイルが「aaa.xls」とし、
B12から順番にファイル名が同じであれば、そのまま処理をします。
bbbになった時点で、また「ファイルを開く」ダイアログを表示させ、
ファイル(「bbb.xls」)を開いて処理を再開するということなんですが。。。

ファイル名は2つまでですが、aaaばかりのときもあります。
また、ファイル名が毎月変わるため、「ファイルを開く」ダイアログを使いたいのですが。。。

【47089】Re:For Each〜In〜Nextのマクロエラーに...
発言  Blue  - 07/2/28(水) 16:08 -

引用なし
パスワード
   同じフォルダに入っていれば、何度もファイル選択ダイアログを出さずにすむんですけどね。
(ユーザにはどのフォルダに対象ファイルが入っているか指定させるようにする)


異常系の場合はどこで処理を中断させるようにしますか?

・ファイルがない場合
・シートがない場合

現行はシートがない場合そこで終了するようになっていますけど。
(次のファイルを見に行くようなことはしていない)

【47090】Re:For Each〜In〜Nextのマクロエラーに...
質問  ボボ  - 07/2/28(水) 16:18 -

引用なし
パスワード
   ▼Blue さん:
ありがとうございます!
以下よろしくお願いします!

>同じフォルダに入っていれば、何度もファイル選択ダイアログを出さずにすむんですけどね。
>(ユーザにはどのフォルダに対象ファイルが入っているか指定させるようにする)

ファイルはこのマクロが終わったら捨てていますので、
デスクトップにおいています。
ファイル名が毎回違うので、単純にファイル選択ダイアログを開かないと、
と思ってしまったのですが・・・

>異常系の場合はどこで処理を中断させるようにしますか?
>
>・ファイルがない場合
>・シートがない場合
>
>現行はシートがない場合そこで終了するようになっていますけど。
>(次のファイルを見に行くようなことはしていない)

・ファイルがない場合、でしょうか。

【47091】Re:For Each〜In〜Nextのマクロエラーに...
発言  Blue  - 07/2/28(水) 16:38 -

引用なし
パスワード
   ▼ボボ さん:
>・ファイルがない場合、でしょうか。

えーと、処理としては2重ループになると思っています。
(ファイル名のループ、シート名のループ)

イメージとしては


For Each ファイル名 in B12〜H12
  
   If 開いているファイルとファイル名が一緒でない Then
     ファイルのパスを取得する
 
     If ファイル名と一致しない? Then
       どうする?
       ここは無視して
       次のファイルに進む?
       それとも異常系だから終了させる?
     End If
   End If

   For Each r in B3〜H3

     該当シートを取得
     If シートがない Then
        どうする?
        無視して次のシートに進む?
        それともこのファイルを見るのはやめて、次のファイルに進む?
        やっぱり異常系だから終了させる?
     End If
     コピー

   Next
Next

てな感じだと思っています。

【47092】Re:For Each〜In〜Nextのマクロエラーに...
お礼  ボボ  - 07/2/28(水) 16:41 -

引用なし
パスワード
   ▼Blue さん:
なるほど、ありがとうございます!
早速参考にさせていただきます。

いろいろとありがとうございました。

また分からなくなったら質問させてください!

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