Excel VBA質問箱 IV

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

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


15722 / 76734 ←次へ | 前へ→

【66487】Re:ループ処理を教えてください
回答  Hirofumi  - 10/9/6(月) 5:18 -

引用なし
パスワード
   こんなのでは

Option Explicit

Public Sub Sample_1()

  With Worksheets("あ")
    Select Case .Range("G1").Value
      Case Is = "A"
        Worksheets("い").Columns(1).Copy Destination:=.Columns(1)
        Worksheets("う").Columns(1).Copy Destination:=.Columns(2)
        Worksheets("え").Columns(1).Copy Destination:=.Columns(3)
        Worksheets("お").Columns(1).Copy Destination:=.Columns(4)
      Case Is = "B"
        Worksheets("い").Columns(2).Copy Destination:=.Columns(1)
        Worksheets("う").Columns(2).Copy Destination:=.Columns(2)
        Worksheets("え").Columns(2).Copy Destination:=.Columns(3)
        Worksheets("お").Columns(2).Copy Destination:=.Columns(4)
      Case Is = "C"
        Worksheets("い").Columns(3).Copy Destination:=.Columns(1)
        Worksheets("う").Columns(3).Copy Destination:=.Columns(2)
        Worksheets("え").Columns(3).Copy Destination:=.Columns(3)
        Worksheets("お").Columns(3).Copy Destination:=.Columns(4)
    End Select
  End With
  
End Sub

Public Sub Sample_2()

  Dim vntSheets As Variant
  
  vntSheets = Array("い", "う", "え", "お")
  
  With Worksheets("あ")
    Select Case .Range("G1").Value
      Case Is = "A"
        Worksheets(vntSheets(0)).Columns(1).Copy _
            Destination:=.Columns(1)
        Worksheets(vntSheets(1)).Columns(1).Copy _
            Destination:=.Columns(2)
        Worksheets(vntSheets(2)).Columns(1).Copy _
            Destination:=.Columns(3)
        Worksheets(vntSheets(3)).Columns(1).Copy _
            Destination:=.Columns(4)
      Case Is = "B"
        Worksheets(vntSheets(0)).Columns(2).Copy _
            Destination:=.Columns(1)
        Worksheets(vntSheets(1)).Columns(2).Copy _
            Destination:=.Columns(2)
        Worksheets(vntSheets(2)).Columns(2).Copy _
            Destination:=.Columns(3)
        Worksheets(vntSheets(3)).Columns(2).Copy _
            Destination:=.Columns(4)
      Case Is = "C"
        Worksheets(vntSheets(0)).Columns(3).Copy _
            Destination:=.Columns(1)
        Worksheets(vntSheets(1)).Columns(3).Copy _
            Destination:=.Columns(2)
        Worksheets(vntSheets(2)).Columns(3).Copy _
            Destination:=.Columns(3)
        Worksheets(vntSheets(3)).Columns(3).Copy _
            Destination:=.Columns(4)
    End Select
  End With
  
End Sub

Public Sub Sample_3()

  Dim i As Long
  Dim vntSheets As Variant
  
  vntSheets = Array("い", "う", "え", "お")
  
  With Worksheets("あ")
    Select Case .Range("G1").Value
      Case Is = "A"
        For i = 0 To UBound(vntSheets, 1)
          Worksheets(vntSheets(i)).Columns(1).Copy _
              Destination:=.Columns(i + 1)
        Next i
      Case Is = "B"
        For i = 0 To UBound(vntSheets, 1)
          Worksheets(vntSheets(i)).Columns(2).Copy _
              Destination:=.Columns(i + 1)
        Next i
      Case Is = "C"
        For i = 0 To UBound(vntSheets, 1)
          Worksheets(vntSheets(i)).Columns(3).Copy _
              Destination:=.Columns(i + 1)
        Next i
    End Select
  End With
  
End Sub

Public Sub Sample_4()

  Dim i As Long
  Dim j As Long
  Dim vntMark As Variant
  Dim vntSheets As Variant
  Dim vntComp As Variant
  
  vntSheets = Array("い", "う", "え", "お")
  vntComp = Array("A", "B", "C")
  
  With Worksheets("あ")
    vntMark = .Range("G1").Value
    For i = 0 To UBound(vntComp, 1)
      If vntMark = vntComp(i) Then
        Exit For
      End If
    Next i
    '条件以内なら
    If i <= UBound(vntComp, 1) Then
      For j = 0 To UBound(vntSheets, 1)
        Worksheets(vntSheets(j)).Columns(i + 1).Copy _
            Destination:=.Columns(j + 1)
      Next j
    End If
  End With
  
End Sub
1 hits

【66485】ループ処理を教えてください Gobou 10/9/5(日) 23:27 質問
【66487】Re:ループ処理を教えてください Hirofumi 10/9/6(月) 5:18 回答
【66488】Re:ループ処理を教えてください Hirofumi 10/9/6(月) 6:10 回答
【66489】Re:ループ処理を教えてください Yuki 10/9/6(月) 15:43 発言

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