30本目 名札作成(段組み)

VBA100本ノック

VBA100本ノック 30本目を動画で解説しています。Excelの神髄さんの模範解答はコチラ


問題

#VBA100本ノック 30本目
古臭いですが名札を作ることになりました。
「名簿」シートのB列に役職、C列に名前が入っています。
「名簿」から「名札」を作成してください。
「名札」はレイアウト・書式を作成済みですが、行数は毎回変わるので3行目以降は1,2行目からコピーしてください。
※画像参照

解答

Sub test1()

    Dim ws1: Set ws1 = Sheets("名簿")
    Dim ws2: Set ws2 = Sheets("名札")
    
    ws2.Cells(1, 1) = ws1.Cells(2, 2)
    ws2.Cells(2, 1) = ws1.Cells(2, 3)
    ws2.Cells(1, 2) = ws1.Cells(3, 2)
    ws2.Cells(2, 2) = ws1.Cells(3, 3)
    
    ws2.Cells(3, 1) = ws1.Cells(4, 2)
    ws2.Cells(4, 1) = ws1.Cells(4, 3)
    ws2.Cells(3, 2) = ws1.Cells(5, 2)
    ws2.Cells(4, 2) = ws1.Cells(5, 3)

End Sub

Sub test2()

    Dim ws1: Set ws1 = Sheets("名簿")
    Dim ws2: Set ws2 = Sheets("名札")
    Dim i
    For i = 2 To 5
        ws2.Cells(1, 1) = ws1.Cells(2, 2)
        ws2.Cells(1 + 1, 1) = ws1.Cells(2, 3)
        
        ws2.Cells(1, 2) = ws1.Cells(3, 2)
        ws2.Cells(1 + 1, 2) = ws1.Cells(3, 3)
        
        ws2.Cells(1 + 2, 1) = ws1.Cells(4, 2)
        ws2.Cells(1 + 1 + 2, 1) = ws1.Cells(4, 3)
        ws2.Cells(1 + 2, 2) = ws1.Cells(5, 2)
        ws2.Cells(1 + 1 + 2, 2) = ws1.Cells(5, 3)
    Next

End Sub

Sub test3()

    Dim ws1: Set ws1 = Sheets("名簿")
    Dim ws2: Set ws2 = Sheets("名札")
    Dim i As Long
    Dim k As Long: k = 1
    
    For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
        If i Mod 2 = 0 Then
            ws2.Cells(k, 1) = ws1.Cells(i, 2)
            ws2.Cells(k + 1, 1) = ws1.Cells(i, 3)
        Else
            ws2.Cells(k, 2) = ws1.Cells(i, 2)
            ws2.Cells(k + 1, 2) = ws1.Cells(i, 3)
            k = k + 2
        End If
    Next i

End Sub
新人君
新人君

初心に戻ることも

大切ですよね!

ブチョ
ブチョ

未来を見据えることも

大切だぞ!

新人君
新人君

お、たまにはいいこと言うやん…

コメント

タイトルとURLをコピーしました