【徒然VBA】A列の値を10行ずつB～K列に転記する処理をA列の最終行まで繰り返す

2023年12月16日 22:57

WEBで検索したんだけど、
ぱっと見、意外となかった
結構、頻繁に使いそう
👉コードを情報共有がてら公開。
（約2年半ぶりくらいにVBAをやってみた。）

ま、思い出しがてら1時間くらいで作っただけだから、あんまり参考にならないかもだし、今時はRPAやGAS、AIなんかでデータスクレイピングでやるだろうけどね👀

具体的には、

桜木支店
桜木町
111-1111
11-1111-1111
000-1111-1111
本部
関東
本社
2023/12/16
22:11
錦支店
錦町
111-1121
22-1111-1111
000-1111-1112
本部
東北
東北支社
2023/12/16
21:57
桂町支店
桂町
111-1113
11-1111-4111
000-1111-1123
本部
関東
関東支社
2023/12/16
22:11
六本木支店
六本木支店
111-1111
11-1111-1111
000-1111-1111
西部
関東
本社
2023/12/16
22:22

てな感じのデータを

コードの書き方もツールもすでに色んなモノがあるだろうけど、あくまでもいちばんオーソドックスなコードでやってみた💦

今回書いたコード

Option Explicit
Sub A列を10行ずつ転記処理()
    Dim 開始, 終了 As Double
    開始 = Timer
    Call 高速化
    Call A列の値を10行ずつBからK列に転記
    Call 高速化解除
    終了 = Timer
    Rem メッセージに出したいとき
    MsgBox (終了 - 開始) & "秒"
    Rem ログに出したいとき
    Debug.Print (終了 - 開始) & "秒"
End Sub
Sub A列の値を10行ずつBからK列に転記()
    Dim A列の行, 転記行, 転記列, 処理カウント, 割る数 As Integer
    転記行 = 1: 転記列 = 1: 処理カウント = 0
    割る数 = 10 '構成が変わったらここを変更するだけ
    For A列の行 = 1 To Cells(rows.Count, 1).End(xlUp).row
            転記列 = 転記列 + 1
            Cells(転記行, 転記列).Value = Cells(A列の行, 1).Text
            処理カウント = 処理カウント + 1
            If 処理カウント Mod 割る数 = 0 Then
                転記行 = 転記行 + 1
                転記列 = 1
            End If
    Next A列の行
End Sub
Sub 高速化()
    Call 画面更新停止
    Call 手動計算
End Sub
Sub 高速化解除()
    Call 画面更新再開
    Call 自動計算
End Sub
Sub 画面更新停止()
  Application.ScreenUpdating = False
End Sub
Sub 画面更新再開()
  Application.ScreenUpdating = True
End Sub
Sub 手動計算()
    Application.Calculation = xlCalculationManual      '手動計算
End Sub
Sub 自動計算()
  Application.Calculation = xlCalculationAutomatic  '自動計算
End Sub