見出しのないエラー列に見出しをつけて表の左側にコピーするよ

makotoym

2025年2月3日 22:59

この説明は、ChatGPTで作成しています。

このマクロは、エラーデータが含まれる列に見出しをつけ、その列を表の左側にコピーする処理を行います。具体的には、以下の流れで動作します。

処理の流れ

画面の更新を止める（処理を速くするため）
エラーデータが入っている列を探す
- 表の最後の列を取得
- 右側5列のうち、3行目にデータがある列を探す
- 見つかった列に「ERR_列名_列番号」という見出しをつける
表の左側に新しい列を追加（エラーデータの列の数だけ）
エラーデータを左側にコピーする
画面の更新を再開する

ポイント

エラーデータがある列に自動で見出しをつけるので、データ整理がしやすくなる
追加した列の見出しは「ERR_列名_列番号」の形式になる（例：「ERR_D_10」）
もともとエラーデータがあった列はそのまま残る

関連リンク

Sub 見出しのないエラー列に見出しをつけて表の左側にコピーするよ()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Set ws = ActiveSheet

    ' 最後のカラムを取得します
    Dim lastColumn As Long
    lastColumn = ws.Cells(2, ws.Columns.count).End(xlToLeft).Column
'    エラーメッセージを５列分確認してカラム名いれる
    Dim colLetter As String
    Dim i As Integer
    Dim pulse As Integer
    pulse = 0
    For i = lastColumn + 1 To lastColumn + 5
        If WorksheetFunction.CountA(ws.Cells(3, i)) >= 1 Then
            colLetter = Split(ws.Cells(1, i).Address(True, False), "$")(0)
            ws.Cells(2, i) = "ERR_" & colLetter & "_" & i
            pulse = pulse + 1
        End If
    Next i
'    １列目の最終行を取得
    Dim lastRow As Long
    lastRow = ws.Cells(Rows.count, 1).End(xlUp).Row
'    左側に列をERR分だけ挿入する
    Dim i2 As Integer
    For i2 = 1 To pulse
        Columns(i2).Insert
    Next i2
'    追加した列にERR列の値をコピーする
    Dim i3, i4 As Long
    For i3 = 1 To pulse
        For i4 = 2 To lastRow
            ws.Cells(i4, i3) = ws.Cells(i4, lastColumn + pulse + i3)
        Next i4
    Next i3
    
    Application.ScreenUpdating = True
End Sub

English Translation

Adding Headers to Error Columns Without Headers and Copying Them to the Left of the Table

This explanation is created using ChatGPT.

This macro identifies columns containing error data, adds headers to them, and copies these columns to the left side of the table. The steps are as follows:

Process Flow

Turn off screen updating (to speed up the process).
Find columns containing error data
- Get the last column of the table.
- Check the 3rd row of the next 5 columns to see if they contain data.
- Add a header in the format "ERR_ColumnName_ColumnNumber" to the identified columns.
Insert new columns on the left side (based on the number of error columns found).
Copy the error data to the newly inserted columns.
Turn screen updating back on.

Key Points

Automatically assigns headers to columns containing error data, making data organization easier.
The new column headers follow the format "ERR_ColumnName_ColumnNumber" (e.g., "ERR_D_10").
The original columns containing error data remain unchanged.

Related Hashtags

#excel #whatyoucando #vba #errorhandling #dataorganization #macro #insertcolumns #automation #datacopy #beginnerprogramming #officework #excelproductivity #vba_basics #tablemanagement #excelmacro #datamovement #autoheaders #workflowoptimization #beginnerVBA #workefficiency