文字の変換について教えて下さい。

質問

あるブックのＣ列に、
会社名（全角の漢字・英字・カタカナ）が入力されているシートが、100シートあります。
（各シートの行数は違います。）
文字化けをしている字を探して、『★』（全角）にする（変換）作業をするのですが、
件数があまりにも膨大なため、一行づつ見ていくと、見落としや時間もかかります。

沢山のシートのデータから、
一瞬で文字化けの字を見分けて、その文字だけ『★』に変換する事は無理だと思いますので、

例えば、Ｃ列には、必ず日本語以外の文字は入らないとして、
日本語以外の、ハングルや記号や半角文字が入っているセルに色をつける・・・とか、
日本語以外の、ハングルや記号や半角文字が入っている行を別シートに抽出する・・・などが出来たら間違いも非常に少なくなるのに・・・・と考えています。

出来ましたら、複数シートを一度に・・・・・が願いです。
わがままで　すみません。

何か　いい方法はないものでしょうか・・・・・

どうぞ　よろしくお願いします！

回答No.4

DOUGLAS_ · ベストアンサー

先ず、
＞シートの名前で、入れたらいけない文字
はありません。「入れたらいけない文字」は シート に名前を付ける段階で排除されていますので、マクロ の進行上、問題は全然ないと存じます。

＞個人用マクロにコードを貼りつけて実行した
　Personal.xls のことですか？

　こういう コード は、回答者から特に指定がない場合は、当該ブック の 標準モジュール に貼り付けてお試しいただかないと不具合の元です。

　先ず、「ThisWorkbook.Sheets.Count」が明らかに変わってしまいます。

＞最初のシートのデータだけで、
＞あとのシートには、反映されてないのです。
は、これが原因だと存じますが、私の コード にも ミス が判明いたしましたので、とりあえず、下記１点をご訂正ください。
。
For mySh = 1 To ThisWorkbook.Sheets.Count
と
For myRow = 1 To Cells(Rows.Count, "C").End(xlUp).Row
との間に
Sheets(mySh).Select
を入れてください。

＞Range("A2").Resize(UBound(myArr) + 1) = Application.Transpose(myArr)
＞のところで、『実行時エラー'13'
は、「文字化け」が１つも無かったということになるのですが、上記の訂正で、このエラーは出なくなると存じます。

＃本当は、「文字化け」が１つも無かったときの エラートラップ をしなければならないのでしょうが。。。
＃それと、「Sheets」という表現は「グラフシート」とかがある場合は、全部「Worksheets」に置換してください。

お礼

DOUGLAS_さま、再度、回答を考えていただき
ありがとうございます！

コードを　Personal.xls　に貼り付けてしまい
すみません　ｍ(；＿；)ｍ
コードの意味ばかりたずね歩き、
貼り付ける場所のことを考えてなくて、反省しました。　
これから、ThisWorkbook.Sheets.Count　が変わってしまうこと等を頭に入れて勉強していきます。

教えていただいたように貼りつけ、一行挿入して実行しましたら、
　　　　　　できました　（＾＾）！
このようなことが出来るとは、全く思ってもみませんでした。
項目も、シート名ばかりか、わかりやすく会社名までいれてくださり、文字化けヶ所の指定までも・・・・

『置換されては困る文字は、随時
　strPattern = "[^０-９Ａ-Ｚａ-ｚぁ-ヶ一二三五七九〇万亜-黑]"
　の「一」の前当たりに羅列してください。』
使うたびに、パワーアップしていくような、
ずっと受け継いでいけるマクロにしていただいて、本当に、感謝しております。

回答No.3

DOUGLAS_

＞Ｃ列に、会社名（全角の漢字・英字・カタカナ）が
＞入力されているシートが、100シートあるブックの
＞文字化けをしている字を探して、
＞その文字だけ『★』に変換する
＞日本語以外の、ハングルや記号や半角文字が
＞入っている行を別シートに抽出する

でよろしいでしょうか？

・全角英数字
・ひらがな
・全角カタカナ
・漢字全部（第１・２水準のみ）
以外の文字を「★」に置き換え、当該シート上では、
「0０1１AＡaａあアアㅧ㈗㉦亜黑」が
「★０★１★Ａ★ａあ★ア★★★亜黑」というように置換され、最後に「文字化け検査結果」シートに

シート名　行番号　会社名　文字化けヶ所
Sheet1　5行目　0０1１AＡaａあアアㅧ㈗㉦亜黑　1文字目「0」　3文字目「1」　5文字目「A」　・・・

と羅列して表示されます。

置換されては困る文字は、随時
strPattern = "[^０-９Ａ-Ｚａ-ｚぁ-ヶ一二三五七九〇万亜-黑]"
の「一」の前当たりに羅列してください。

Sub 文字化け検査()
　Dim RE As Object
　Dim strPattern As String
　Dim mySh As Long
　Dim myRow As Long
　Dim myRng As Range
　Dim Matches As Object
　Dim Match As Object
　Dim myArr As Variant
　Set RE = CreateObject("VBScript.RegExp")
　strPattern = "[^０-９Ａ-Ｚａ-ｚぁ-ヶ一二三五七九〇万亜-黑]"
　With RE
　　.Pattern = strPattern
　　.Global = True
　　For mySh = 1 To ThisWorkbook.Sheets.Count
　　　For myRow = 1 To Cells(Rows.Count, "C").End(xlUp).Row
　　　　Set myRng = Sheets(mySh).Cells(myRow, "C")
　　　　If .Test(myRng.Text) Then
　　　　　myArr = myArr & Sheets(mySh).Name & vbTab & _
　　　　　　　myRow & "行目" & vbTab & myRng.Text & vbTab
　　　　　Set Matches = .Execute(myRng.Text)
　　　　　For Each Match In Matches
　　　　　　myRng.Value = Replace(myRng.Text, Match.Value, "★")
　　　　　　myArr = myArr & Match.FirstIndex + 1 & "文字目「" & Match.Value & "」" & vbTab
　　　　　Next
　　　　　myArr = myArr & vbNewLine
　　　　End If
　　　Next myRow
　　Next mySh
　End With
　Set RE = Nothing
　myArr = Split(myArr, vbNewLine)
　Sheets.Add before:=Sheets(1)
　ActiveSheet.Name = "文字化け検査結果"
　Range("A1:D1") = Array("シート名", "行番号", "会社名", "文字化けヶ所")
　Range("A2").Resize(UBound(myArr) + 1) = Application.Transpose(myArr)
　Range("A2").Resize(UBound(myArr) + 1).TextToColumns Tab:=True
　Rows("2:" & Range("A2").End(xlDown).Row).Columns.AutoFit
End Sub

お礼

DOUGLAS_さま、回答、ありがとうございます！

『Ｃ列に、会社名（全角の漢字・英字・カタカナ）が入力されているシートが、100シートあるブックの、
　文字化けをしている字を探して　その文字だけ『★』に変換する
　日本語以外の、ハングルや記号や半角文字が入っている行を別シートに抽出する

　でよろしいでしょうか？』

はい、その通りです。

>・全角英数字
>・ひらがな
>・全角カタカナ
>・漢字全部（第１・２水準のみ）
>以外の文字を「★」に置き換え、

る・・・えっ、そのようなことが出来るのですね　（・ー・）人

シートが6つあるブックで実行しました。
個人用マクロにコードを貼りつけて実行したところ、最後から4行上の、
Range("A2").Resize(UBound(myArr) + 1) = Application.Transpose(myArr)
のところで、『実行時エラー'13'　　型が一致しません』　
とでて、それ以上　進まなかったので、
コードを一度消して　シートの内容を少し変えて、操作を最初に戻し、貼りつけて実行したところ、
シートの最初に『文字化け検査結果』が追加されて、文字化け検査結果が出ました！

しかし、最初のシートのデータだけで、
なぜか、2番目からのシートからあとのシートには、反映されてないのです。

何回か、おなじ事を繰り返して実行してみたのですが、やはり、最初のシートの検索結果しか出ないのです。

原因は、私のデータの内容がおかしいのだと思われます。
せっかく作ってくださったのに、スミマセン。今からまた、いろいろ試しデータを作って、挑戦してみます。
それか、マクロを実行する時に、シートの名前で、入れたらいけない文字などが　あるのでしょうか？

回答No.2

tom04

こんにちは！

文字化けしている文字に対応できるかどうか判りませんが・・・
とりあえず各SheetのC1セルから一文字ずつ舐めるように検索し、半角の場合のみ「★」に変えてみました。

一例です。

↓のコードを標準モジュールにコピー＆ペーストしてマクロを試してみてください。

Sub test()
Dim i, j, k As Long
Dim str As String
For i = 1 To Worksheets.Count
For j = 1 To Worksheets(i).Cells(Rows.Count, 3).End(xlUp).Row
For k = 1 To Len(Worksheets(i).Cells(j, 3))
str = Mid(Worksheets(i).Cells(j, 3), k, 1)
If LenB(StrConv(str, vbFromUnicode)) = 1 Then
Worksheets(i).Cells(j, 3) = Replace(Worksheets(i).Cells(j, 3), str, "★")
End If
Next k
Next j
Next i
End Sub

尚、1行目がタイトル行になっているのであれば
＞For j = 1 To Worksheets(i).Cells(Rows.Count, 3).End(xlUp).Row
の「1」の部分を適宜変更してみてください。

それから最初に書いたようにすべてのSheetのC列を一文字ずつ舐めるように検索してますので
かなり時間がかかるかもしれません。

一旦マクロを実行すると元に戻せませんので、別Bookにデータをコピーしてマクロを試してみてくださいね。
希望通りにならなかったらごめんなさいね。m(_ _)m

※　追伸
あまり夜遅くまで根を詰めてPCとにらめっこしないでね！
寝不足は○○に良くないみたいですよ！(@^^)/~~~

お礼

こんばんは、tom04さん♪（！▽！）
達人コードで練習しましたら、沢山のシートの半角文字が、一瞬で、星になりました★

何度　教えて頂いても、そのたびに、更に感動します。
こんなに短いコードの中で、何を宣言して、何が行われて、
達人は、どんな所を簡単にしとってんかな・・・なにが違うのかな・・・・と、
研究したくならない人が いるのでしょうか。

いつも、回答と一緒に、やる気をいただき、ありがとうございます　p(^ー^ )q

※　追伸
ご心配、ありがとうございます！ （＾ワ＾）　
ＰＣとにらめっこは〇〇に良くない・・・・（笑）　うん、確かに！
『一日4時間睡眠で生活できる方法』という分厚い本を見つけ、福屋で真剣に立ち読み（正確には、しゃがみ読み）しましたが、
途中で突然眠くなり、内容は、あんまりおぼえてないのです（￣０￣ｑ　ガーン
寝てる間の時間がもったいなくて・・・でも、おっしゃる通り、〇〇が最優先ですよね。
ゆっくり勉強、研究します。
優しい　お心遣いに、感謝の気持ちでいっぱいです。

回答No.1

aokii

エンコードにより違いますので、文字化けしているかどうかの判定自体が大切です。

会社名でピボットテーブルを作り、正しい会社名リストをエクセルのEXACT関数を使って、一致していないものを見つけてはいかがでしょうか。

また、正しい会社名リストが無いようでしたら、不完全ですが半角文字が含まれるセルのみを抽出するために、LEN関数とLENB関数の値を比較して一致しないセルを見つける方法で少しは見つけられるでしょう。

=IF(LEN(A1)*2-LENB(A1)<>0,"半角文字を含むセルです","全角文字のみのセルです")

お礼

aokiiさま、回答、ありがとうございます。

>また、正しい会社名リストが無いようでしたら、

そんなんです・・・ないのです。
正しいものがあれば、
一行づつ見ていくことをしなくても、検索や比較などで何とか見つけることもできると思うのですけど、
アドバイスを参考にさせていただきます！
ありがとうございました。