[[20250213144342]]　『VBAを使ってxlsxファイルを読み込みたい』（Y）　ページの最後に飛ぶ

『VBAを使ってxlsxファイルを読み込みたい』（Y）

VBAを使って「.xlsxファイル同士の差分を表示する」というマクロを組んでいます。
テキストファイルや.csvファイルは上手くいくのですが、拡張子を変えると上手くいきません。
また、文字コードを指定するのですが、Excelの標準の文字コードである「Shit-JIS」や「UniCode」では文字化けをしたり、表示されなくたったりします。

コードは下記サイトを参考にしています。
https://qiita.com/tsuando_c/items/670a7b37f75e97e8f75c

＜使用 Excel：Microsoft365、使用 OS：Windows11 ＞

 うまくいかないだけだと取り付く島もないので、
 コードを提示されたらいかがですか？

（xyz） 2025/02/13(木) 15:07:22

 xlsxファイルをテキストファイル(含むCSV)と同じ開き方をすることはできません。
 Workbooks.Openで開いて下さい。
 また文字コードを気にすることは不要です。
（xyz） 2025/02/13(木) 15:15:06

ファイル１を読み込むコード

Public Sub Main1()

    '変数の宣言
    Dim filepath_1 As String, filepath_2 As String
    Dim wb As Workbook
    Dim ws_result As Worksheet, ws_csv_1 As Worksheet, ws_csv_2 As Worksheet
    Dim code_1 As String, code_2 As String

    'ワークブック、シートオブジェクトをセット
    Set wb = ThisWorkbook
    Set ws_result = wb.Worksheets("result")
    Set ws_csv_1 = wb.Worksheets("csv_1")
    Set ws_csv_2 = wb.Worksheets("csv_2")

    'csvファイルのパスと文字コードを設定
    filepath_1 = ws_result.Cells(3, 3)
    code_1 = "-8"
    filepath_2 = ws_result.Cells(4, 3)
    code_2 = "UTF-8"

    'csvファイルの読み込み
    LoadCSV filepath_1, ws_csv_1, code_1
    LoadCSV filepath_2, ws_csv_2, code_2

End Sub

ファイル2を読み込むコード

Public Sub Main2()

    '変数の宣言
    Dim wb As Workbook
    Dim ws_result As Worksheet, ws_csv_1 As Worksheet, ws_csv_2 As Worksheet

    'ワークブック、シートオブジェクトをセット
    Set wb = ThisWorkbook
    Set ws_result = wb.Worksheets("result")
    Set ws_csv_1 = wb.Worksheets("csv_1")
    Set ws_csv_2 = wb.Worksheets("csv_2")

    'シートを比較
    CompareSheets ws_result, ws_csv_1, ws_csv_2
End Sub

'filepathのcsvファイルをシートwsに出力
Private Function LoadCSV(FilePath As String, ws As Worksheet, code As String)

    '変数の宣言
    Dim buf As String
    Dim i As Long, j As Long
    Dim rows As Variant, row As Variant
    Dim num_rows As Variant, num_cols As Variant
    Dim data_array As Variant

    'シート初期化
    ws.UsedRange.Delete

    With CreateObject("ADODB.Stream")
        .Charset = code
        .Open
        .LoadFromFile FilePath
        buf = .ReadText
        .Close
    End With
    'Windos環境とLinux環境の改行コードの違いを解消
    buf = Replace(buf, vbCrLf, vbLf)
    buf = Replace(buf, vbLf, vbCrLf)

    'Cells(14, 5).Value = buf
    '改行で分割して配列化
    rows = Split(buf, vbCrLf)

    '行取得
    '配列.Length+1
    num_rows = UBound(rows) + 1
    '列数取得
    '配列.Length+1
    num_cols = UBound(Split(rows(0), ",")) + 1

    'csvの行数x列数の2次元配列で再宣言
    ReDim data_array(1 To num_rows, 1 To num_cols)
    'すべての要素をdata_arrayに格納、要素数に注意
    For i = 1 To num_rows:
        row = Split(rows(i - 1), ",")
        If UBound(row) > 1 Then
            For j = 1 To num_cols
                'ファイルの中身が配列の有効範囲を超える？
                'csvファイルはテーブルの記入やデータベースを使うファイルである
                data_array(i, j) = row(j - 1)
            Next j
        End If
    Next i

    'csvの全要素をシートに出力
   ws.Range("A1").Resize(num_rows, num_cols).Value = data_array

End Function

Private Function CompareSheets(ws_result As Worksheet, ws_csv_1 As Worksheet, ws_csv_2 As Worksheet)

    '変数の宣言
    Dim cells_1 As Variant, cells_2 As Variant
    Dim num_rows_1 As Long, num_cols_1 As Long
    Dim num_rows_2 As Long, num_cols_2 As Long
    Dim i As Long, j As Long
    Dim index As Long, res As Long

    '結果一覧をクリア
    'ws_result.Range("A12", Range("A12").SpecialCells(xlLastCell)).Clear
    'ws_result.Range("B12", Range("B12").SpecialCells(xlLastCell)).Clear
    'ws_result.Range("A12", Range("C12").SpecialCells(xlLastCell)).Clear

    'csvデータを配列に格納
    cells_1 = ws_csv_1.UsedRange 'csvファイル１
    cells_2 = ws_csv_2.UsedRange 'csvファイル２

    '大きさを確認
    'A1,B1,A2,B2に表示された比較対象の行、列の大きさを比較する
    num_rows_1 = UBound(cells_1, 1)
    num_cols_1 = UBound(cells_1, 2)
    num_rows_2 = UBound(cells_2, 1)
    num_cols_2 = UBound(cells_2, 2)

    'シート１とシート２の行、列の数
    Cells(7, 2).Value = num_rows_1
    Cells(8, 2).Value = num_cols_1
    Cells(7, 3).Value = num_rows_2
    Cells(8, 3).Value = num_cols_2

    If num_rows_1 <> num_rows_2 Then
        MsgBox "行数が一致しません、終了します。"
        Exit Function
    End If
    'If num_cols_1 <> num_cols_2 Then
    '    MsgBox "列数が一致しません、終了します"
    '    Exit Function
    'End If

    '結果一覧の準備
    ws_result.Cells(11, 1) = "No."
    ws_result.Cells(11, 2) = "File１内容"
    ws_result.Cells(11, 7) = "File２内容"

    '2つのシートを比較して、一致していないセルを黄色に塗り、対象セルの一覧を出力する
    index = 0
    For i = 1 To num_cols_1
        For j = 1 To num_rows_1
            '等しくなければ色を変更
            If cells_1(j, i) <> cells_2(j, i) Then
                '対象のセルの色を黄色に変更
                ws_csv_1.Cells(j, i).Interior.ColorIndex = 6
                ws_csv_2.Cells(j, i).Interior.ColorIndex = 6
                '比較するファイル名を出力
                ws_result.Cells(12 + index, 1) = index + 1
                ws_result.Cells(12 + index, 2) = ws_csv_1.Cells(j, i)
                ws_result.Cells(12 + index, 7) = ws_csv_2.Cells(j, i)
                index = index + 1
                If index Mod 1000 = 0 Then
                    res = MsgBox("不一致が" & index & "/" & i * j & "件見つかっています。処理を続けますか？", vbYesNo)
                    If res = vbNo Then
                        Exit Function
                    End If
                End If
            End If
        Next j
    Next i

    If index = 1 Then
        MsgBox "全要素が一致しました!"
    End If
End Function

同ファイルにあるcsv_1シートとcsv_2シートに複製して、2シートのセルの差分を結果として表示したいです。
（Y） 2025/02/13(木) 15:57:49

マクロ作成が目的とかではなく、「.xlsxファイル同士の差分を表示する」のが目的であるのなら、↓こんなのも（Excelの「検査」機能を活用）。

https://yone.synapse-site.jp/excel2016/excel2016_file_hikaku.html

（ふぐ食べたい） 2025/02/13(木) 16:46:45

 再掲します。
 > xlsxファイルをテキストファイル(含むCSV)と同じ開き方をすることはできません。
 > Workbooks.Openで開いて下さい。
 > また文字コードを気にすることは不要です。
 >（xyz） 2025/02/13(木) 15:15:06
（xyz） 2025/02/13(木) 18:21:48

csvの中身はテキストファイルなので文字コードを気にする必要がありまずが、xlsxファイルはxyzさんの言う通りのものです。
現在は「LoadCSV」というFunctionでcsvファイルを読み込んでいますが、そのFunction部分をxlsxファイル用に専用に用意し、xlsxファイルの場合はそのFunctionを使うように切り替えるぐらいかと。
Functionの内容としては指定したxlsxファイルを開いて(シートが一つだけなら)先頭のワークシートの中身を本ファイルのワークシートにコピー、というぐらいなのでググればいっぱいサンプルはあるしAIに聞いてもすぐ作ってくれるかと思います。
（abec） 2025/02/13(木) 19:55:34

コメント返信：

[ 一覧(最新更新順) ]

[[20250213144342]] 『VBAを使ってxlsxファイルを読み込みたい』（Y） ページの最後に飛ぶ

[[20250213144342]]　『VBAを使ってxlsxファイルを読み込みたい』（Y）　ページの最後に飛ぶ