《excel or word》全角文字を検索して削除、もしくは半角文字のみを抜き出したい

質問

全角文字で書かれた、日本語の文があります。（一般的な文章ですので、文字数は勿論任意です）
その中に、半角英数字8文字で書かれたID番号が点在しています。
（IDの前後の文字数、またひとつの分の総文字数は任意です）

…という内容が一つのセルに入っていて、それが数千行あるエクセルのブックがあります。

この中から、半角英数字8文字のIDのみ、取り出したいのです。
（半角英数字はIDにしか使われていない、という認識です）

１）半角8桁の英数字だけ別セルに取り出す
関数で何とかならないかと思いましたが、ごく一般的な文章なので、IDの前後の文字数がバラバラで断念しました

２）全角文字のみ検索し、置き換えで削除する
ワードにコピーしてやってみようと思いました。
2003なのですが、「任意の英数字」は検索できても、「任意の全角文字」の検索機能はないようです。
（「任意の文字」の項目が、全角文字に該当するのかと思い、検索置換をしてみたら、どうやら半角英数字も該当するようでした）

実際困っております。
何かいい手はないでしょうか。

回答No.6

noname#52504

無理やり関数で処理してみました（半分冗談ですが）

一つのセルに入る文字数は高々　32767=2^15-1　文字ですから、
半分ずつに区切って、半角文字を含むかどうかの判定を繰り返せば、
最大でも15回で位置が判明します。

以下、元データがA列2行目以降に入っているとします。

１．A1セル：=2^(INT(LOG(MAX(LEN(A2:A9999)),2))+1)
　　を配列数式として入力(Ctrl+Shift+Enter)
２．B1セル：=A1/2
３．B2セル：=(LEN(LEFT($A2,B$1))*2)=LENB(LEFT($A2,B$1))
４．C2セル：=(LEN(LEFT($A2,SUM($B$1:B$1*$B2:B2)+C$1))*2)=LENB(LEFT($A2,SUM($B$1:B$1*$B2:B2)+C$1))
　　を配列数式として入力(Ctrl+Shift+Enter)
５．B1セルを1が返るまで右方向にフィル（以下、仮にH1が1になったとします)
６．C2セルをH列まで右方向にフィル
７．I1セル：=MID($A2,SUM($B$1:$H$1*$B2:$H2)+1,8)　←５によってセル範囲変わります
　　を配列数式として入力(Ctrl+Shift+Enter)
８．B2，C2，…，Q2セルをそれぞれ下方向にフィル
　　…の前に下記註をご参考下さい。

Excel2003で動作確認済

※下方向へのフィルを複数列まとめてやると、固まるかもしれません。
※必要に応じて、列単位で処理⇒その都度値貼り付けで確定　など工夫してください。
※セル内改行：CHAR(10)は半角扱いになるので、
　セル内改行がある場合はあらかじめ削除しておいてください。

回答No.5

himajin100000

#あ、いけね、俺のコード
テストに用いた時の名残で
[0-9a-zA-z]{7}
になってる
[0-9a-zA-z]{8}
ね。

ま、この辺は大体皆似たような手法になるか。

回答No.4

Wendy02

こんにちは。

#2 で書いた者ですが、パターンがダブっていました。

.Pattern = "[^\w\d]"
　　　↓
.Pattern = "[^\w]"

ただし、パターンは、\wですと、半角英数字で、「_ (アンダースコア)」が入ってしまいます。

必ず、半角英数を8文字を出すようにしてみました。また、一行に複数あっても、カンマつきですが、出力するようにしました。値コピーして、それで、区切り位置に、「,（カンマ)」を使えば、セルひとつずつに別けることも可能です。

それと、IngnoreCase =True なら、大文字・小文字は関係ありません。
単に、アンダースコアが気にならないのなら、\w{8}でも可能です。

Function RegGetCode(myStr As String) As String
Dim Match As Object
Dim buf As String
　　With CreateObject("VBScript.RegExp")
　　　　.Pattern = "[0-9a-z]{8}" '"\w{8}"
　　　　.Global = True
　　　　.IgnoreCase = True
　　If .Test(myStr) Then
　　For Each Match In .Execute(myStr)
　　 buf = buf & "," & Match.Value
　　Next
　　RegGetCode = Mid$(buf, 2)
　　End If
　　End With
End Function

回答No.3

zap35

エクセルで回答します。昨日の回答の使い回しで申しわけありませんが
http://oshiete1.goo.ne.jp/qa3158346.html　No.3
で１行変更すれば半角英数字を取り出せます。変更するのは以下です
　変更前　strPattern = "[0-9A-Za-z０-９Ａ-Ｚａ-ｚ]"
　変更後　strPattern = "[0-9A-Za-z]"

でも文章中に半角英数字はID以外になく、IDは８文字と決まっているなら関数でもできそうですね。A1に文字列があるとき
=MID($A$1,MAX(INDEX((CODE(MID($A$1,ROW(INDIRECT("1:"&LEN($A$1))),1))<123)*ROW(INDIRECT("1:"&LEN($A$1))),))-7,8)
で半角英数字8桁を取り出せます。

回答No.2

Wendy02

こんにちは。

>全角文字のみ検索し、置き換えで削除する

ということなら、

'標準モジュール

Function RegRepl(myStr As String) As String
　　With CreateObject("VBScript.RegExp")
　　　　.Pattern = "[^\w\d]"
　　　　.Global = True
　　　　RegRepl = .Replace(myStr, "")
　　End With
End Function

においてあげればよいはずです。ただし、半角英数が点在していたら、これは役には立ちません。

VBE に貼り付けたら、以下のような数式にしてあげれば出来ます。

=RegRepl(A1)

回答No.1

himajin100000

Option Explicit
'Excel VBA

Sub Sample2()
Dim RE As Object
Dim strPattern As String
Dim msg As String
Dim MatchCollection As Object
Dim Match As Object
Dim r As Object

Set RE = CreateObject("VBScript.RegExp")
strPattern = "[0-9a-zA-z]{7}"
With RE
.Pattern = strPattern
.IgnoreCase = True
.Global = True
For Each r In ActiveSheet.UsedRange

Set MatchCollection = .Execute(r)
If MatchCollection.Count > 0 Then
For Each Match In MatchCollection
msg = msg & Match.Value & vbCrLf
Next

End If
Next
End With
MsgBox msg
Set Match = Nothing
Set RE = Nothing
End Sub

とかは？

参考資料
http://officetanaka.net/excel/vba/tips/tips38.htm