人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

【ベストアンサーに 1000pt ?】【文字列比較プログラム】

文字列 A と文字列 B に含まれる数字を比較したいと考えています。
両者に含まれる数字がすべて同じであれば真、1 つでも異なる場合は偽としたいです。

文字列 A:私は 30 才です。
文字列 B:I am 30 years old.
結果は真となります。

文字列 A:5 人の男が 6 つのリンゴを買いました。
文字列 B:5 men bought 4 apples.
結果は偽となります。

特に指定はありませんが、Word/Excel VBA あたりでお願いします。
実現できるツールがすでにあればそれを教えてください。
Terapad を使っています。秀丸は使っていません。

採用回答には 1000pt ?

詳細はコメントをご覧ください。

●質問者: にぎたま
●カテゴリ:ビジネス・経営 コンピュータ
✍キーワード:AM Excel TeraPad VBA Word
○ 状態 :終了
└ 回答数 : 5/5件

▽最新の回答へ

1 ● pahoo
●500ポイント

ExcelVBA のプログラム例を示します。

2つ以上の数字が含まれる場合、数字の順序が異なる場合は「偽」と判定します。


セル A1, A2 に比較する文字列を代入してからマクロ実行してください。

セル A3 に結果(一致/出現頻度が異なる/数値が異なる)が代入されます。


Sub JECompare()
 Dim re As Object
 Dim mt1 As Object, mt2 As Object
 Dim i As Integer
 Set re = CreateObject("VBScript.RegExp")
 re.Pattern = "[0-9\,\.]+" '検索する正規表現パターン(半角数字、カンマ、小数点有り)
 re.Global = True '検索範囲はグローバル
 re.IgnoreCase = True '大文字・小文字を区別する

 Set mt1 = re.Execute(Range("A1"))
 Set mt2 = re.Execute(Range("A2"))

 '----出現頻度を比較する
 If (mt1.Count <> mt2.Count) Then
 Range("A3") = "出現頻度が異なる"
 Else
 '----1つずつ数値を比較する
 flag = True
 For i = 0 To (mt1.Count - 1)
 If (mt1.Item(i).Value <> mt2.Item(i).Value) Then
 flag = False
 End If
 Next i
 If (flag <> True) Then
 Range("A3") = "数値が異なる"
 Else
 Range("A3") = "一致"
 End If
 End If

End Sub

2 ● Mook
●1250ポイント ベストアンサー

面白そうなので、VBA で作成してみました。

順不問とのことですので初期設定をそのようにしていますが、順序一致を確認するときは

sortMode を False にするとそのようになります。


Option Explicit

'--- ソートモード
' 数字の順番が異なってもよいときは True
' 数字の順番が一致しなければいけないときは False
' に設定
Const sortMode = True

'------------------------------------------------
' A 列とB列を比較し、結果を C列 に入れます。
'------------------------------------------------
Sub numComps()
'------------------------------------------------
 Dim sortMode As Boolean
 Dim lastRow As Long
 lastRow = Range("A" & Rows.Count).End(xlUp).Row
 
 Dim i As Long
 Dim src As String, dst As String
 For i = 1 To lastRow
 src = Cells(i, "A").Value
 dst = Cells(i, "B").Value
 
 If numsCheck(src, dst) Then
 Cells(i, "C").Value = "OK"
 Cells(i, "C").Interior.ColorIndex = 0  ' セルに色を白に
 Else
 Cells(i, "C").Value = "NG"
 Cells(i, "C").Interior.ColorIndex = 3  ' セルに色を赤に
 End If
 Next
End Sub

'------------------------------------------------
' 文字列を比較し、True or False を返す。
'------------------------------------------------
Function numsCheck(src As String, dst As String) As Boolean
 Dim srcAry As Variant
 Dim dstAry As Variant
 
 srcAry = getNumArray(src)
 dstAry = getNumArray(dst)
 MsgBox Join(srcAry, "::")
 MsgBox Join(dstAry, "::")
 numsCheck = False
 
 If UBound(srcAry) <> UBound(dstAry) Then
 Exit Function
 End If
 
 Dim i As Long
 For i = 0 To UBound(srcAry)
 If srcAry(i) <> dstAry(i) Then
 Exit Function
 End If
 Next
 numsCheck = True
End Function

'------------------------------------------------
' 文字列から数値を取得し配列で返す。
' sortMode が True のときは、数値配列を昇順にする
'------------------------------------------------
Function getNumArray(sentence) As Variant
 Dim regEx As Object
 Set regEx = CreateObject("VBScript.RegExp")
 Dim Match, Matches

 regEx.Pattern = "[\d,.]+"
 regEx.IgnoreCase = True
 regEx.Global = True
 
'--- 文字列から数値を取得
 Set Matches = regEx.Execute(sentence)
 Dim ret As String, numStr As String
 For Each Match In Matches  ' Matches コレクションに対して繰り返し処理を行います。
 If IsNumeric(Match.Value) Then
'--- 語末の「.」と「,」は無視
 If Right(Match.Value, 1) = "." Or Right(Match.Value, 1) = "," Then
 numStr = Left(Match.Value, Len(Match.Value - 1))
 Else
 numStr = Match.Value
 End If
 
 If ret = "" Then
 ret = ret & numStr
 Else
 ret = ret & "/" & numStr
 End If
 End If
 Next

 Dim ar As Variant
 ar = Split(ret, "/")
 If UBound(ar) = 0 Then
 getNumArray = ar
 End If
 
'--- ソート
 Dim i As Long, j As Long
 Dim tmp As String
 If sortMode = True Then
 For i = 0 To UBound(ar)
 For j = i + 1 To UBound(ar)
 If CDbl(ar(i)) > CDbl(ar(j)) Then
 tmp = ar(i)
 ar(i) = ar(j)
 ar(j) = tmp
 End If
 Next
 Next
 End If
 
 getNumArray = ar
End Function

一応の動作確認はしましたが、なにかありましたらコメントください。


3 ● SALINGER
●750ポイント

ExcelVBAの正規表現で、A列とB列に文字。C列に真偽を表示します。

Option Explicit

Sub Macro()
 Dim RE
 Dim strPattern As String
 Dim reMatch1
 Dim reMatch2
 Dim str1 As String
 Dim str2 As String
 Dim i As Long
 Dim j As Long
 Dim f As Boolean
 Dim h()
 Dim r As Long
 
 Set RE = CreateObject("VBScript.RegExp")
 
 r = 1
 While Cells(r, 1).Value <> ""
 str1 = Cells(r, 1).Value
 str2 = Cells(r, 2).Value
 
  '2つの文字列の数字を正規表現で抽出
 strPattern = "[0-9]+"
 With RE
 .Pattern = strPattern
 .IgnoreCase = True
 .Global = True
 Set reMatch1 = .Execute(str1)
 Set reMatch2 = .Execute(str2)
 End With
 
  '2つ目の文字を別の配列に挿入
 ReDim h(reMatch2.Count)
 For i = 0 To reMatch2.Count - 1
 h(i) = reMatch2(i).Value
 Next i
 
 Cells(r, 3).Value = "真"
 
  '2つの配列を比較
 For i = 0 To reMatch1.Count - 1
 f = False
 For j = 0 To reMatch2.Count - 1
 If reMatch1(i).Value = h(j) Then
 h(j) = ""
 f = True
 Exit For
 End If
 Next j
 If f = False Then
 Cells(r, 3).Value = "偽"
 Exit For
 End If
 Next i
 
 r = r + 1
 Wend
 
 Set RE = Nothing
End Sub

4 ● きゃづみぃ
●100ポイント

ExcelのVBAで標準モジュールに

Function ChkNum(a As String, b As String) As Boolean
 ChkNum = True
 For c = 0 To 9
 If InStr(a, c) > 0 Then d = 1 Else d = 0
 If InStr(b, c) > 0 Then d = d + 10
 If d <> 11 And d <> 0 Then
 ChkNum = False
 Exit For
 End If
 Next c
End Function

と入れてください。

あとは セル上で

=chknum(A1,B1)

とすれば FALSEかTRUEが表示されます。


5 ● Mook
●10ポイント

面白そうな題材でしたので、VBA で作成してみました。

結果は、C列に OK, NG で表示するようにしています。


お手数ですが、VBE の 「ツール」⇒「参照設定」で

「Microsoft VBScript Regular Expressions」にチェックを入れて、実行ください。


注1)語順は不問にしていますが、語順一致にしたい場合は sortMode を False に変更ください。

数値の全角半角は識別していませんので、識別する場合は wideMode を False にしてください。


注2)ただし全角半角を識別しない場合、全角文字は数値と見なさないのでご注意ください。

(全角を排除したい場合には有効なチェックにかもしれませんが、それ以外は使い道ないかも・・・。)


Option Explicit

'--- ソートモード
' 数字の順番が異なってもよいときは True
' 数字の順番が一致しなければいけないときは False
' に設定
Const sortMode = True

'--- 全角モード
' 数字が全角でもよいときは True
' 数字が半角でなければまずいときは False
' に設定
Const wideMode = True

'------------------------------------------------
' A 列とB列を比較し、結果を C列 に入れます。
'------------------------------------------------
Sub numComps()
'------------------------------------------------
 Dim sortMode As Boolean
 Dim lastRow As Long
 lastRow = Range("A" & Rows.Count).End(xlUp).Row
 
 Dim i As Long
 Dim src As String, dst As String
 For i = 1 To lastRow
 If wideMode = True Then
 src = StrConv(Cells(i, "A").Value, vbNarrow)
 dst = StrConv(Cells(i, "B").Value, vbNarrow)
 Else
 src = Cells(i, "A").Value
 dst = Cells(i, "B").Value
 End If
 
 If numsCheck(src, dst) Then
 Cells(i, "C").Value = "OK"
 Cells(i, "C").Interior.ColorIndex = 0  ' セルに色を白に
 Else
 Cells(i, "C").Value = "NG"
 Cells(i, "C").Interior.ColorIndex = 3  ' セルに色を赤に
 End If
 Next
End Sub

'------------------------------------------------
' 文字列を比較し、True or False を返す。
'------------------------------------------------
Function numsCheck(src As String, dst As String) As Boolean
 Dim srcAry As Variant
 Dim dstAry As Variant
 
 srcAry = getNumArray(src)
 dstAry = getNumArray(dst)
 
 numsCheck = False
 
 If UBound(srcAry) <> UBound(dstAry) Then
 Exit Function
 End If
 
 Dim i As Long
 For i = 0 To UBound(srcAry)
 If srcAry(i) <> dstAry(i) Then
 Exit Function
 End If
 Next
 numsCheck = True
End Function

'------------------------------------------------
' 文字列から数値を取得し配列で返す。
' sortMode が True のときは、数値配列を昇順にする
'------------------------------------------------
Function getNumArray(sentence) As Variant
 Dim Match, Matches
 Dim regEx As New RegExp
 
 regEx.Pattern = "\d+"
 regEx.IgnoreCase = True
 regEx.Global = True
 
'--- 文字列から数値を取得
 Set Matches = regEx.Execute(sentence)
 Dim ret As String
 For Each Match In Matches  ' Matches コレクションに対して繰り返し処理を行います。
 If ret = "" Then
 ret = ret & Match.Value
 Else
 ret = ret & "," & Match.Value
 End If
 Next

 Dim ar As Variant
 ar = Split(ret, ",")
 If UBound(ar) = 0 Then
 getNumArray = ar
 End If
 
'--- ソート
 Dim i As Long, j As Long
 Dim tmp As String
 If sortMode = True Then
 For i = 0 To UBound(ar)
 For j = i + 1 To UBound(ar)
 If CLng(ar(i)) > CLng(ar(j)) Then
 tmp = ar(i)
 ar(i) = ar(j)
 ar(j) = tmp
 End If
 Next
 Next
 End If
 
 getNumArray = ar
End Function

簡単な動作チェックはしていますが、問題ありましたらコメントください。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ