Excel VBA 逆引き集 | 1行ずつ読み取り → 処理

Excel VBA
スポンサーリンク

1行ずつ読み取り → 処理

「1行ずつ読み取って、条件ごとに処理する」定番パターンを、シート行とテキスト/CSV行の両方でまとめます。初心者でも即使える最短コードと実務テンプレを軸に、落とし穴まで押さえます。

シートの行を1行ずつ処理する

'基本：A列の最終行まで1行ずつ計算（数量C×単価D→金額E）
Sub RowByRow_ToLast()
    Dim last As Long, r As Long
    last = Cells(Rows.Count, "A").End(xlUp).Row
    For r = 2 To last
        If IsNumeric(Cells(r, "C").Value) And IsNumeric(Cells(r, "D").Value) Then
            Cells(r, "E").Value = Cells(r, "C").Value * Cells(r, "D").Value
        End If
    Next r
End Sub
VB
  • 基本の軸: A列基準で最終行を取り、2行目から回すのが定番。
  • 安全な判定: 数値チェックを入れて型エラーを避ける。
'Do…Loop：空白に当たるまで1行ずつ処理（B列が空で終了）
Sub RowByRow_UntilBlank()
    Dim r As Long: r = 2
    Do Until Trim(Cells(r, "B").Value) = ""
        Cells(r, "F").Value = "処理済"
        r = r + 1
    Loop
End Sub
VB
  • 終了条件: 「空になるまで」や「キーワードに当たるまで」を明確に書く。
'フィルタ後の可視行だけ処理（重複防止のため列1本で回す）
Sub RowByRow_VisibleOnly()
    Dim rg As Range, vis As Range, c As Range
    Set rg = Range("A1").CurrentRegion
    rg.AutoFilter Field:=2, Criteria1:="営業A"  '例：B列で抽出

    On Error Resume Next
    Set vis = rg.Offset(1).Resize(rg.Rows.Count - 1).Columns(1).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If Not vis Is Nothing Then
        For Each c In vis
            Cells(c.Row, "H").Value = Cells(c.Row, "C").Value * Cells(c.Row, "D").Value
        Next c
    End If
End Sub
VB
  • 重複回避: 行単位処理は「列1本に限定して Rowで横展開」が鉄則。
  • 可視限定: SpecialCells(xlCellTypeVisible)は該当0件エラー対策が必須。
'削除は下からが安全（空行削除の定番）
Sub RowByRow_DeleteBlanksReverse()
    Dim last As Long, r As Long
    last = Cells(Rows.Count, "A").End(xlUp).Row
    For r = last To 2 Step -1
        If Application.WorksheetFunction.CountA(Rows(r)) = 0 Then Rows(r).Delete
    Next r
End Sub
VB
  • 削除のセオリー: 逆順で削除すれば行が詰まってもインデックスが崩れない。

行ごとの処理テンプレート（速度ラップ付き）

Sub RowByRow_Template()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim last As Long, r As Long
    last = Cells(Rows.Count, "A").End(xlUp).Row
    For r = 2 To last
        '例：重要フラグで分岐
        If Cells(r, "F").Value = "重要" Then
            Cells(r, "G").Value = Cells(r, "C").Value * Cells(r, "D").Value
            Rows(r).Interior.Color = RGB(255, 235, 156)
        Else
            Cells(r, "G").Value = ""
        End If
    Next r

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
VB
  • 速度最適化: 画面更新・再計算OFF→ONで大量行でも軽快。
  • 副作用注意: 数式上書きは消える。値化が目的かを明確に。

テキスト/CSVを1行ずつ読み取り → 処理する

'標準I/O：Line Input #で1行ずつ読み取る（CSVをSplit）
Sub ReadCsv_LineInput()
    Dim fn As Integer, path As String, line As String
    path = "C:\temp\data.csv"
    fn = FreeFile
    Open path For Input As #fn

    Dim r As Long: r = 2
    Do Until EOF(fn)
        Line Input #fn, line
        Dim parts As Variant: parts = Split(line, ",")
        '例：A,B,C,Dへ書き込み
        Dim i As Long
        For i = LBound(parts) To UBound(parts)
            Cells(r, i + 1).Value = parts(i)
        Next i
        r = r + 1
    Loop
    Close #fn
End Sub
VB
  • 手軽さ: 標準構文で依存なし。CSVはSplitで簡単に列化。
  • 改行単位: Line Input #は1行ずつ安全に取り出せる。
'FSO：ReadLineで1行ずつ（余裕があればこちらも便利）
Sub ReadText_FSO_ReadLine()
    Dim fso As Object, ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.OpenTextFile("C:\temp\log.txt", 1) '1=読み取り

    Dim r As Long: r = 2
    Do Until ts.AtEndOfStream
        Dim s As String: s = ts.ReadLine
        Cells(r, "A").Value = s
        r = r + 1
    Loop
    ts.Close
End Sub
VB
  • FSOの利点: ファイル存在チェックやパス操作など周辺機能が充実。
  • AtEndOfStream: ファイル末尾判定で確実に終了。

例題で練習

'例題1：最初の「緊急」行で処理して終了（Exit For）
Sub Example_FirstUrgentExit()
    Dim last As Long, r As Long
    last = Cells(Rows.Count, "A").End(xlUp).Row
    For r = 2 To last
        If Cells(r, "A").Value = "緊急" Then
            Rows(r).Font.Bold = True
            Cells(r, "H").Value = "最初の緊急"
            Exit For
        End If
    Next r
End Sub

'例題2：フィルタ後の見えている行だけ「数量×単価」を金額へ
Sub Example_VisibleCalc()
    Dim rg As Range, vis As Range, c As Range
    Set rg = Range("A1").CurrentRegion
    rg.AutoFilter Field:=3, Criteria1:=">=80"  '例：C列で抽出

    On Error Resume Next
    Set vis = rg.Offset(1).Resize(rg.Rows.Count - 1).Columns(1).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    If Not vis Is Nothing Then
        For Each c In vis
            Cells(c.Row, "E").Value = Cells(c.Row, "C").Value * Cells(c.Row, "D").Value
        Next c
    End If
End Sub

'例題3：CSVを1行ずつ読み、欠損を「N/A」で補完して貼り付け
Sub Example_ReadCsvAndClean()
    Dim fn As Integer, line As String, parts As Variant
    fn = FreeFile
    Open "C:\temp\data.csv" For Input As #fn
    Dim r As Long: r = 2
    Do Until EOF(fn)
        Line Input #fn, line
        parts = Split(line, ",")
        Dim i As Long
        For i = LBound(parts) To UBound(parts)
            If Trim$(parts(i)) = "" Then
                Cells(r, i + 1).Value = "N/A"
            Else
                Cells(r, i + 1).Value = parts(i)
            End If
        Next i
        r = r + 1
    Loop
    Close #fn
End Sub
VB

実務の落とし穴と対策

  • 終了条件の明記: 「どこまで回すか」を必ず書く（最終行、空白、EOF、キーワード）。
  • 重複処理の罠: 可視セルは列1本で回す。範囲全体を回すと同じ行が列数分ヒットする。
  • 数式の上書き: 値書き込みで数式が消える。値化が目的か見た目変更かを区別し、書式なら Interior/Font に切り替える。
  • ファイルの文字コード: Shift-JIS前提のLine Input #はUTF-8 BOM付きで崩れることがある。必要なら外部変換やADODB.Streamの検討。
  • 速度最適化: 行ごとのセルアクセスは遅い。可能なら「配列に読み込み→一括書き戻し」に置き換える。
Sub SpeedWrap_RowByRow()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    '…1行ずつの本処理…
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
VB
スポンサーリンク
タイトルとURLをコピーしました