HOME > Q&A > Excel （VBA）

Excel （VBA）
Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録（無料）が必要です。会員登録がまだの方はこちら
  • 「掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 10 Home : Excel 2016)
50個のシートのデータを出力する方法について
投稿日時: 23/07/15 21:07:45
投稿者: コアラ

データを入力したシートが50枚あります。シートの様式は全て同じで、シート名はFdata1からFdata50となっています。入力したデータのみを出力するコードを下記のとおり記述しましたが、連続して出力するコードがどうしても分かりません。ご教示のほどよろしくお願いいたします。
出力するデータは、Mdataの2行目以降に出力したいと考えています。
 
Sub test()
 
Dim ws1 As Worksheet
Dim ws2 As Worksheet
 
Set ws1 = Worksheets("Fdata1")
Set ws2 = Worksheets("Mdata")
 
    ws2.Cells(2, 1).Value = ws1.Range("F5").Value
    ws2.Cells(2, 2).Value = ws1.Range("U5").Value
    ws2.Cells(2, 3).Value = ws1.Range("H6").Value
    ws2.Cells(2, 4).Value = ws1.Range("L6").Value
    ws2.Cells(2, 5).Value = ws1.Range("V6").Value
    ws2.Cells(2, 6).Value = ws1.Range("H7").Value
    ws2.Cells(2, 7).Value = ws1.Range("L7").Value
    ws2.Cells(2, 8).Value = ws1.Range("R7").Value
    ws2.Cells(2, 9).Value = ws1.Range("F8").Value
    ws2.Cells(2, 10).Value = ws1.Range("F9").Value
    ws2.Cells(2, 11).Value = ws1.Range("F10").Value
    ws2.Cells(2, 12).Value = ws1.Range("S8").Value
    ws2.Cells(2, 13).Value = ws1.Range("S9").Value
    ws2.Cells(2, 14).Value = ws1.Range("S10").Value
    ws2.Cells(2, 15).Value = ws1.Range("F11").Value
    ws2.Cells(2, 16).Value = ws1.Range("E13").Value
    ws2.Cells(2, 17).Value = ws1.Range("E14").Value
    ws2.Cells(2, 18).Value = ws1.Range("E15").Value
    ws2.Cells(2, 19).Value = ws1.Range("E16").Value
    ws2.Cells(2, 20).Value = ws1.Range("E17").Value
    ws2.Cells(2, 21).Value = ws1.Range("I17").Value
    ws2.Cells(2, 22).Value = ws1.Range("E18").Value
    ws2.Cells(2, 23).Value = ws1.Range("E19").Value
    ws2.Cells(2, 24).Value = ws1.Range("H19").Value
    ws2.Cells(2, 25).Value = ws1.Range("E20").Value
    ws2.Cells(2, 26).Value = ws1.Range("G23").Value
    ws2.Cells(2, 27).Value = ws1.Range("G24").Value
    ws2.Cells(2, 28).Value = ws1.Range("G25").Value
    ws2.Cells(2, 29).Value = ws1.Range("G26").Value
    ws2.Cells(2, 30).Value = ws1.Range("L23").Value
    ws2.Cells(2, 31).Value = ws1.Range("L24").Value
    ws2.Cells(2, 32).Value = ws1.Range("L25").Value
    ws2.Cells(2, 33).Value = ws1.Range("L26").Value
    ws2.Cells(2, 34).Value = ws1.Range("R23").Value
    ws2.Cells(2, 35).Value = ws1.Range("R24").Value
    ws2.Cells(2, 36).Value = ws1.Range("R25").Value
    ws2.Cells(2, 37).Value = ws1.Range("R26").Value
End Sub
 
 
 
回答
投稿日時: 23/07/15 22:38:10
投稿者: WinArrow

考え方として、シート単位の処理と、シートの中身の処理の２つのプロシジャに分けます。
 
シート単位の処理のプロシジャをMAINとします。
シートの中身の処理のプロシジャをCOPYSUBとします。
シートは、MAIN側で定義し、COPYSUBに引数で渡します。
COPYSUBでは、個々のセルの複写をセル同士で転記するのではなく
一旦、配列に格納してから、転記先シートに一括代入します。（処理速度時短のため）
 
参考コード
 

Sub Main()
Dim wsNO As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim RX As Long

    Set ws2 = Worksheets("Mdata")
    RX = 2
    For wsNO = 1 To 50
        Set ws1 = Worksheets("Fdata" & wsNO)
        Call COPYSUB(ws1:=ws1, ws2:=ws2, RX:=RX)
        RX = RX + 1
    Next
End Sub

Sub COPYSUB(ByRef ws1 As Worksheet, ByRef ws2 As Worksheet, ByRef RX As Long)
Dim DATA(1 To 1, 1 To 37)

    DATA(1, 1) = ws1.Range("F5").Value
    DATA(1, 2) = ws1.Range("U5").Value
    DATA(1, 3) = ws1.Range("H6").Value
    '・
    '省略
    
    ws1.Cells(RX, 1).Resize(, 37).Value = DATA
End Sub

回答
投稿日時: 23/07/16 10:38:38
投稿者: WinArrow

引用:

Sub COPYSUB(ByRef ws1 As Worksheet, ByRef ws2 As Worksheet, ByRef RX As Long)
Dim DATA(1 To 1, 1 To 37)
 
    DATA(1, 1) = ws1.Range("F5").Value
    DATA(1, 2) = ws1.Range("U5").Value
    DATA(1, 3) = ws1.Range("H6").Value
    '・
    '省略
     
    ws1.Cells(RX, 1).Resize(, 37).Value = DATA
End Sub

の簡素化を提案します。
 
WorkSheetS("ws1CELLADD")に
ws1のセルドレステーブルを作成し、転記コードを簡略します。
 
参考コード 
Sub COPYSUB(ByRef ws1 As Worksheet, ByRef ws2 As Worksheet, ByRef RX As Long)
Dim DATA(1 To 1, 1 To 37)
Dim wsX As Worksheet
Dim CELLADD, Wx As Long

Set wsX = Worksheets("ws1CELLADD")
    
    CELLADD = wsX.Range("A1:A37")
    For Wx = 1 To 37
        DATA(1, Wx) = ws1.Range(CELLADD(Wx, 1)).Value
    Next
    ws1.Cells(RX, 1).Resize(, 37).Value = DATA
End Sub

回答
投稿日時: 23/07/17 14:55:52
投稿者: simple

既に適切な回答をいただいていますので、蛇足ですが追記しておきます。
 
繰り返しを使う必要がありますね。こんな風な書き方はいかがでしょうか。 

Sub test()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim k   As Long 

    Set ws2 = Worksheets("Mdata")

    For k = 1 To 50 
        Set ws1 = Worksheets("Fdata" & k)

        ws2.Cells(k+1, 1).Value = ws1.Range("F5").Value
        ws2.Cells(k+1, 2).Value = ws1.Range("U5").Value
        ws2.Cells(k+1, 3).Value = ws1.Range("H6").Value
        ws2.Cells(k+1, 4).Value = ws1.Range("L6").Value
        '  （中略)  
        ws2.Cells(k+1, 34).Value = ws1.Range("R23").Value
        ws2.Cells(k+1, 35).Value = ws1.Range("R24").Value
        ws2.Cells(k+1, 36).Value = ws1.Range("R25").Value
        ws2.Cells(k+1, 37).Value = ws1.Range("R26").Value
    Next
End Sub

■
 Subプロシージャや Functionプロシージャを使って、
 詳細部分をメインのプロシージャから分離すると、
 全体の構図が分かりやすくなるので使うことが多いですね。
 私も最初の回答はそれでした。（重なったので消しましたが）
 
(1)
    Call COPYSUB(ws1:=ws1, ws2:=ws2, RX:=RX)
    は、単に
    Call COPYSUB(ws1, ws2, RX)
    でもOKです。
  （というより、こういう書き方のほうが多いと思います。
    もし使うなら、例えば、
    転記元:=ws1, 転記先:=ws2, 行:=RX などとしますね。定義もそれに応じた手入れが必要。
    今のままだと情報は実質的に増えていませんので、効果が今一つだと思われます。）
(2)
    Sub COPYSUB(ByRef ws1 As Worksheet, ByRef ws2 As Worksheet, ByRef RX As Long)
    これも正確ではありますが、ByRefは省略できます。（デフォルトはByRefなので）
 
    Sub COPYSUB(ws1 As Worksheet, ws2 As Worksheet, RX As Long)
    でもOKです。
 
    もし慣れないかただと、こう書かなければならないと誤解してしまう恐れがあるので、
    老婆心ながら追記しておきます。
(3)
    また、各セルにひとつづつ転記するよりも、配列に保持して、一括して書き込むと、
    速度面での効率が図られます。（既に指摘いただいているとおりです。）
    これも繰り返しができるようになってから、併せて検討されるとよいでしょう。
     
何か不明な点があれば、遠慮なく質問して下さい。（まあ、今日は祝日ですから休まれてから）
投稿日時: 23/07/17 15:21:19
投稿者: コアラ

WinArrow様、simple様
 
お世話になります。
ご教示ありがとうございます。
 
現在、仕事が立て込んでおりまして、ご教示頂いた内容について
検証する時間がなかなか確保できない状況です"(-""-)"
必ず検証のうえ、その内容についてご報告させていただきたいと
考えておりますので、今しばらくお待ちください。
 
よろしくお願いいたします。
トピックに返信