VBAでファイルの読み込みとソート、最大最小計算

エクセルのVBAのコードを紹介します。

この記事でわかること
・テキストファイルをスペース区切りでエクセルに読み込ませる方法
・指定した列に特定の文字がある場合、その行のデータを別シートにコピーする方法
・16進数のデータを10進数に変換する方法
・エクセルのデータから最大/最小/平均を表示する方法

サンプルのテキストファイルは以下を用いました。

ca 11 FF
ca 22 F0
aa 22 0F
aa 12 0F
ca 22 01
aa 22 07
ba 22 0F
aa FE 0F

VBAのコードは以下になります。

'#ファイルを読み込む
Sub ImportSpaceDelimitedTextFile()
    Dim FilePath As String
    Dim TextRow As String
    Dim DataArray() As String
    Dim TargetSheet As Worksheet
    Dim i As Long, j As Long
    Dim NextRow As Long

    ' ファイル選択ダイアログを表示
    FilePath = Application.GetOpenFilename("テキストファイル (*.txt), *.txt")

    ' ユーザーがキャンセルした場合
    If FilePath = "False" Then
        MsgBox "ファイルが選択されていません。", vbExclamation, "キャンセルされました"
        Exit Sub
    End If

    ' 新しいワークシートを追加
    Set TargetSheet = ThisWorkbook.Worksheets.Add
    TargetSheet.Name = "canlog"

    ' テキストファイルを開く
    Open FilePath For Input As #1

    ' ファイルの終わりまで読み込む
    NextRow = 1
    Do While Not EOF(1)
        Line Input #1, TextRow
        ' 連続したスペースを1つのスペースとして扱う
        TextRow = Replace(TextRow, "  ", " ")
        DataArray = Split(TextRow, " ") ' スペースで区切る

        ' 配列のデータをワークシートに書き込む
        For j = LBound(DataArray) To UBound(DataArray)
            TargetSheet.Cells(NextRow, j + 1).Value = "'" & DataArray(j)
        Next j

        NextRow = NextRow + 1
    Loop

    ' ファイルを閉じる
    Close #1

    MsgBox FilePath & " からデータがインポートされました。", vbInformation, "インポート完了"
    End Sub


'#caの列を別シートに移す
Sub MoveRowsBasedOnCriteria()
    Dim sourceSheet As Worksheet
    Dim destinationSheet As Worksheet
    Dim lastRow As Long
    Dim matchValue As String
    Dim cell As Range
    Dim destRow As Long
    
    ' 新しいワークシートを追加
    Set TargetSheet = ThisWorkbook.Worksheets.Add
    TargetSheet.Name = "caデータ"

    ' ソースシートとデスティネーションシートを設定
    Set sourceSheet = ThisWorkbook.Sheets("canlog")
    Set destinationSheet = ThisWorkbook.Sheets("caデータ")

    ' 最後の行を取得
    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row

    ' 移動する特定のデータを設定
    matchValue = "ca" ' ここに条件となる値を入力

    ' デスティネーションシートの次の空白行を取得
    destRow = destinationSheet.Cells(destinationSheet.Rows.Count, "A").End(xlUp).Row

    ' A列を 上から下にループ
    For i = 1 To lastRow Step 1
        Set cell = sourceSheet.Cells(i, 1)
        If cell.Value = matchValue Then
            ' 条件に一致する行を別のシートに移動
            cell.EntireRow.Copy Destination:=destinationSheet.Rows(destRow)
            ' ソースシートから該当行を削除
            'cell.EntireRow.Delete
            ' 次の空白行を更新
            destRow = destRow + 1
        End If
    Next i
    

End Sub



'#データを16進数から10進数に変換する
Sub ConvertHexToDec()
    Dim CA_data As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim hexValue As String
    Dim decValue As Long
    Dim lastRow As Long

    ' 変換するセル範囲を設定
    Set CA_data = ThisWorkbook.Sheets("caデータ")
    ' 最後の行を取得
    lastRow = CA_data.Cells(CA_data.Rows.Count, "B").End(xlUp).Row
    ' B列のデータが入っている範囲を設定します
    Set rng = CA_data.Range("B1:B" & lastRow)

    For Each cell In rng
        hexValue = cell.Value
        ' 16進数の文字列を10進数に変換します
        decValue = Val("&H" & hexValue)
        ' 結果を（E列）に出力します
        cell.Offset(0, 3).Value = decValue
    Next cell
End Sub

'#最大最小平均の計算
Sub CalculateStats()
    Dim CA_data As Worksheet
    Dim rng As Range
    Dim maxVal As Double
    Dim minVal As Double
    Dim avgVal As Double

    ' シートを設定します
    Set CA_data = ThisWorkbook.Sheets("caデータ")

    ' 統計を計算する範囲を設定します
    ' 最後の行を取得
    lastRow = CA_data.Cells(CA_data.Rows.Count, "E").End(xlUp).Row
    ' B列のデータが入っている範囲を設定します
    Set rng = CA_data.Range("E1:E" & lastRow)


    ' 最大値、最小値、平均値を計算します
    maxVal = Application.WorksheetFunction.Max(rng)
    minVal = Application.WorksheetFunction.Min(rng)
    avgVal = Application.WorksheetFunction.Average(rng)

    ' 結果をシート上の指定されたセルに出力します
    CA_data.Range("G1").Value = "maxVal"
    CA_data.Range("H1").Value = "minVal"
    CA_data.Range("I1").Value = "avgVal"
    CA_data.Range("G2").Value = maxVal
    CA_data.Range("H2").Value = minVal
    CA_data.Range("I2").Value = avgVal
End Sub