[[20250410151019]]　『TSVデータの文字化けについて』（デスうなぎ）　ページの最後に飛ぶ

『TSVデータの文字化けについて』（デスうなぎ）

こんにちはデスうなぎです。
有識者の方、恐れ入りますがご教授願います。

フォルダ内にある複数のTSVデータを、エクセルマクロブックへコピーする際、数字や英語表記は問題ありませんが、なぜか日本語表記だけ文字化けしてしまい困っております。
対策方法等はございますでしょうか？
よろしくお願い致します。

Sub テスト_Click()

Dim ws As Worksheet
Dim folPath As String, buf As String

folPath = ThisWorkbook.Path
buf = Dir(folPath & "\" & "*.TSV*")
Do Until buf = "" Or buf = ThisWorkbook.Name
Workbooks.Open Filename:=folPath & "\" & buf, ReadOnly:=True
For Each ws In ActiveWorkbook.Worksheets
With ThisWorkbook
ws.Copy after:=.Worksheets(.Worksheets.Count)
End With
Next ws
Workbooks(buf).Close savechanges:=False
buf = Dir()
Loop
MsgBox "コピー完了"
End Sub

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

当該TSVファイルの文字コードをお調べになり
文字コード指定が可能な方法で読み込まれてはどうでしょうか。。。
QueryTables.Addメソッド　とか　ADODB.Stream
m(__)m
（隠居Z） 2025/04/10(木) 15:42:45

 >Workbooks.Open Filename:=folPath & "\" & buf, ReadOnly:=True
 を
 Workbooks.OpenText folPath & "\" & buf, Tab:=True, Origin:=65001, Local:=True
 に変更してみてください。

 ExcelでTextファイルを開く場合は、OpenTextメソッドの方が安全です。
（jindon） 2025/04/10(木) 15:44:27

（隠居Z） 2025/04/10(木) 15:42:45
は　お忘れください　　。。。再現しませんでした。

３６５ですと、自動変換してくれてるのでせうかね。。。^^;　またやってしまったかも
m(__)m
（隠居Z） 2025/04/10(木) 16:14:47

jindon様

デスうなぎです。
ご教授いただいたコードを試したら上手いきました。凄い！
大変助かりました。
ありがとうございます。

隠居Z様

ご返信ありがとうございました！
（デスうなぎ） 2025/04/10(木) 17:13:23

お世話になっております。デスうなぎです。
追加の質問となってしまい、大変恐縮ではございますがご教授願います。
TSVデータを、エクセルマクロブックへコピーした各シートのA列の中に、
文字列"東京01"が含まれいる場合は、そのシート名称を"東京"、文字列"名古屋02"が含まれている場合は、シート名称"名古屋"、文字列"大阪03"が含まれている場合、または上記3つの都市名称いずれも記載のない場合は、シート名称"大阪"へ変更するにはどのようなコードを記入すれば宜しいでしょうか。
なお、上記3つの文字列は各シートA列の中に重複はありません。
それくらい手動でやれよと、お叱りを受けそうですが宜しくお願い致します。

（デスうなぎ） 2025/04/15(火) 21:45:09

 例えばこんな書き方があります。参考にしてください。
    Select Case True
    Case IsNumeric(Application.Match("*東京01*", Columns("A"), 0))
        ActiveSheet.Name = "東京"
    Case IsNumeric(Application.Match("*名古屋02*", Columns("A"), 0))
        ActiveSheet.Name = "名古屋"
    Case Else
        ActiveSheet.Name = "大阪"
    End Select
（xyz） 2025/04/16(水) 08:08:12

おはよ～ございますぅ　　既にご案内ですが。。。(*^^*)
パスとかブック数、ブック名の規則性シート数とシート名、情報のセルアドレス等々
概要、詳細が良く把握できておりませんので
シート名の変更部分だけ。。。何かの足しにでもなれば幸いです、お役に立たなければ
ゴミ箱ポイお願いいたします。
ブック部分はループにするとか、シート名重複があれば別途処理が必要だとお見ます。
何も情報が無くてもシート名は　大阪　に　なってしまいますが、不都合でしたらご修正を^^;
m(__)m　

 Option Explicit
Sub main()
    Dim wNm()
    Dim tWb As Workbook
    Set tWb = ThisWorkbook
    GetWsNames tWb, wNm
    WsNameCange tWb, wNm
    Erase wNm
End Sub
Private Sub WsNameCange(ByVal wB As Workbook, ByRef wNm As Variant)
    Dim i As Long
    Dim j As Long
    Dim sNm As String
    Dim v() As Variant
    Dim r As Range
    Dim x As Variant
    For i = 1 To wB.Worksheets.Count
        With wB.Worksheets(i)
            For j = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
                Select Case True
                    Case .Cells(j, 1).Value Like "*東京*"
                        sNm = "東京"
                    Case .Cells(j, 1).Value Like "*名古屋*"
                        sNm = "名古屋"
                    Case Else
                        sNm = "大阪"
                End Select
            Next
            x = Application.Match(sNm, wNm, 0)
            If IsError(x) Then
                .Name = sNm
                GetWsNames wB, wNm
            End If
        End With
    Next
End Sub
Private Sub GetWsNames(ByVal wB As Workbook, ByRef wSnm As Variant)
    Dim i             As Long
    With wB
        ReDim wSnm(1 To .Worksheets.Count)
        For i = 1 To .Worksheets.Count
            wSnm(i) = .Worksheets(i).Name
        Next
    End With
End Sub

（隠居Z） 2025/04/16(水) 08:16:45

 デスうなぎさん

　>...が含まれいる場合は

 が気になります。
 もしセルの中に他の文字列が混在している、ということであれば myListの各要素の語頭、語末に*(アスタリスク)を付加してください。

 Sub テスト_Click()
    Dim wb As Workbook, myList, wsName
    Dim folPath$, buf$, i&, x, myName$
    Application.ScreenUpdating = False
    Set wb = ThisWorkbook
    myList = Array("東京01", "名古屋02")   '<---必要に応じて変更・追加及び削減
    wsName = Array("東京", "名古屋", "大阪")  '<---上記の変更に準ずる
    folPath = ThisWorkbook.Path
    buf = Dir(folPath & "\" & "*.TSV*")
    Do While buf <> ""
        Workbooks.OpenText folPath & "\" & buf, Tab:=True, Origin:=65001
        With ActiveWorkbook.Sheets(1)
            .Copy , wb.Sheets(wb.Sheets.Count)
            myName = ""
            For i = 0 To UBound(myList)
                x = Application.Match(myList(i), .Columns(1), 0)
                If IsNumeric(x) Then myName = wsName(i): Exit For
            Next
            If myName = "" Then myName = wsName(UBound(wsName))
            wb.Sheets(wb.Sheets.Count).Name = myName
            .Parent.Close False
        End With
        buf = Dir
    Loop
    Application.ScreenUpdating = True
    MsgBox "コピー完了"
End Sub
（jindon） 2025/04/16(水) 09:54:25

 TSVファイルを開いた直後に名前を変更して、その後コピーしたほうがよいかもしれませんね。
 評価して同一名になったとき、コピー処理であればエラーにならずに
 自動的に名前を(2),(3)・・・等と補足してくれるので。
（xyz） 2025/04/16(水) 10:19:03

いつもお世話になっております。デスうなぎでございます。
ご返信遅くなりまして大変申し訳ございませんでした。

私からの要件提示が曖昧にも関わらず、皆様から頂いたコードで無事に問題解決できました。
ありがとうございます。

xyz様　Select Case文法　勉強になりました。
隠居Z様　ゴミ箱ポイなど、とんでもございません。とても参考になりました。
jindon様　参考にさせて頂きます。

今後ともどうぞ宜しくお願い致します。

（デスうなぎ） 2025/04/30(水) 16:09:20

コメント返信：

[ 一覧(最新更新順) ]

[[20250410151019]] 『TSVデータの文字化けについて』（デスうなぎ） ページの最後に飛ぶ

[[20250410151019]]　『TSVデータの文字化けについて』（デスうなぎ）　ページの最後に飛ぶ