[[20070522160336]]　『文字列処理』（おや？）　ページの最後に飛ぶ

『文字列処理』（おや？）

 以下の様な関数は可能でしょうか？
 宜しくお願いします｡

 文字列NO.１
 ＡＢＣ１ＤＥＦZＧ２３ＨＪ
 文字列NO.２
 ＡＢＣ２ＤＥＦZＧ２４ＨＪ

 比較結果
 　〃　２　〃　 　２４ＨＪ

 ・１と２を比較して同じところには、「〃」を入れてその両側にスペースを入れる。
 ・「〃」を入れる場所は、丁度真ん中にならない場合は、前方とします。
 ・詰めるスペースは、文字列NO.１、２の該当文字が全角か半角によって
 ・全角スペースか、半角スペースを入れる。
 ・処理前の文字が半角を含んでいて、全角の「〃」を入れると、前より長くなって
 も良い事とします。
 ・２文字以下は、上記例のＨＪの様に処理しない。
 ・数字の続く物は、その桁数分表示する。上記の例では、２３と２４を比較して３と
 ４だけ異なりますが、２４と表示する。

 WindowsXP,Excel2003

 なかなか難しいですねぇ。
これはユーザー定義関数です。
Alt + F11を押して、挿入-->標準モジュールを選択。
出てきた画面に、下記のコードをコピペして閉じる。
=oya(A1,A2) などと入力してやります。
おや？さんの文字列No.1が1番目の引数、文字列No.2が2番目の引数となっております。
Pのつくフォントだと分かりにくいとおもいますので、それ以外で確認してみて下さい。
(ROUGE)
'----
Function Oya(txt1 As String, txt2 As String)
    Dim i As Long, txt As String, flg As Boolean, n As Long
    With CreateObject("Scripting.Dictionary")
        .CompareMode = BinaryCompare
        For i = 1 To Len(txt2)
            .Add Mid(txt2, i, 1), Empty
            If Not .Exists(Mid(txt1, i, 1)) Then
                txt = txt & Mid(txt2, i, 1)
            Else
                txt = txt & "　"
            End If
            .RemoveAll
        Next
    End With
    For i = 1 To Len(txt2)
        If flg Then
            If Not IsNumeric(Mid(txt2, i, 1)) Then
                flg = False
                If Len(Trim(Mid(txt, n, i - n))) <> 0 Then
                    txt = Left(txt, n - 1) & Mid(txt2, n, i - n) & Mid(txt, i)
                End If
            ElseIf i = Len(txt2) Then
                If Len(Trim(Mid(txt, n))) <> 0 Then
                    txt = Left(txt, n - 1) & Mid(txt2, n)
                End If
            End If
        Else
            If IsNumeric(Mid(txt2, i, 1)) Then
                flg = True
                n = i
            End If
        End If
    Next
    n = 0
    flg = False
    For i = 1 To Len(txt)
        If Mid(txt, i, 1) = "　" And Not flg Then
            If i <> Len(txt) Then
                n = i
                flg = True
            Else
                txt = Left(txt, Len(txt) - 1) & "〃"
            End If
        ElseIf (Mid(txt, i, 1) <> "　" And flg) Or (i = Len(txt) And Mid(txt, i, 1) = "　" And flg) Then
            txt = Left(txt, (n + i - 1) \ 2 - 1) & "〃" & Mid(txt, (n + i - 1) \ 2 + 1)
            flg = False
        End If
    Next
    Oya = txt
End Function

 ROUGEさん、4行目の BinaryCompare は、vbBinaryCompare の
 記入違いということで桶ですか？
（純丸）(o^-')b

 vbBinaryCompare は規定値なので必要ないでしょう。
 (seiya)

 記入違い、不要なもの、いずれのご指摘ともにそのとおりです。。。orz(ROUGE)

ROUGEさん、純丸さん、seiyaさんたいへんありがとうございます。
完全に希望通りのものであることが確認できました。
大変お世話になります。

 すみませんが。
 パッケージ(P-2B)と
 パッケージ(P-3B)を比較した時

 パッケージ(P-2B)
 　　　〃　   3〃 と表示してほしいのですが、

 結果は
 パッケージ(P-2B)
 　　　〃　　　　3〃　
 となります。
 元データが半角、全角によって入れるスペースを
 全角半角判定したいのですが、お願い出来ますでしょうか。
(おや？)

 〃はどうしても全角になりますが、以下でどうでしょうか。(ROUGE)
'----
Function Oya(txt1 As String, txt2 As String)
    Dim i As Long, txt As String, flg As Boolean, n As Long
    With CreateObject("Scripting.Dictionary")
        For i = 1 To Len(txt2)
            .Add Mid(txt2, i, 1), Empty
            If Not .Exists(Mid(txt1, i, 1)) Then
                txt = txt & Mid(txt2, i, 1)
            Else
                txt = txt & IIf(LenB(StrConv(Mid(txt2, i, 1), vbFromUnicode)) = 1, " ", "　")
            End If
            .RemoveAll
        Next
    End With
    For i = 1 To Len(txt2)
        If flg Then
            If Not IsNumeric(Mid(txt2, i, 1)) Then
                flg = False
                If Len(Trim(Mid(txt, n, i - n))) <> 0 Then
                    txt = Left(txt, n - 1) & Mid(txt2, n, i - n) & Mid(txt, i)
                End If
            ElseIf i = Len(txt2) Then
                If Len(Trim(Mid(txt, n))) <> 0 Then
                    txt = Left(txt, n - 1) & Mid(txt2, n)
                End If
            End If
        Else
            If IsNumeric(Mid(txt2, i, 1)) Then
                flg = True
                n = i
            End If
        End If
    Next
    n = 0
    flg = False
    For i = 1 To Len(txt)
        If StrConv(Mid(txt, i, 1), vbNarrow) = " " And Not flg Then
            If i <> Len(txt) Then
                n = i
                flg = True
            Else
                txt = Left(txt, Len(txt) - 1) & "〃"
            End If
        ElseIf (StrConv(Mid(txt, i, 1), vbNarrow) <> " " And flg) Or _
            (i = Len(txt) And StrConv(Mid(txt, i, 1), vbNarrow) = " " And flg) Then
            txt = Left(txt, (n + i - 1) \ 2 - 1) & "〃" & Mid(txt, (n + i - 1) \ 2 + 1)
            flg = False
        End If
    Next
    Oya = txt
End Function

 今回修正して頂いたプログラムですが、〃が二個以上出るのと、
 数字２が無くなりました。

 （Zが半角です。）
 前回修正前
                                                 比較結果
 文字列NO.１	 ＡＢＣ１ＤＥＦZＧ２３ＨＪ	 ＡＢＣ１ＤＥＦZＧ２３ＨＪ
 文字列NO.２	 ＡＢＣ２ＤＥＦZＧ２４ＨＪ	　〃　　２　　〃　　２４〃

 今回修正後		
                                                 比較結果
 文字列NO.１	 ＡＢＣ１ＤＥＦZＧ２３ＨＪ	 ＡＢＣ１ＤＥＦZＧ２３ＨＪ
 文字列NO.２	 ＡＢＣ２ＤＥＦZＧ２４ＨＪ	〃　〃　２〃　〃 　〃４　〃
 (おや？)

 一箇所、等号と不等号を誤っておりました。
 直接コードを修正しておりますので、再度確認お願いします。
 (ROUGE)

 文字列にスペースが無い場合はOKでした。
 文字列にスペースが含まれる場合
 以下の例では、先頭に半角スペース、ＢとＣの間に全角スペース、３とＨの間に
 半角スペースを入れましたが、

 本来こうなるところ

		 比較結果
 文字列NO.１	 ＡＢ　Ｃ１ＤＥＦZＧ２３ ＨＪ	 ＡＢ　Ｃ１ＤＥＦZＧ２３ ＨＪ
 文字列NO.２	 ＡＢ　Ｃ２ＤＥＦZＧ２４ ＨＪ	 　〃　　２　　〃 　２４〃

 この結果となりました。
		 比較結果
 文字列NO.１	 ＡＢ　Ｃ１ＤＥＦZＧ２３ ＨＪ	〃ＡＢ〃Ｃ１ＤＥＦZＧ２３〃ＨＪ
 文字列NO.２	 ＡＢ　Ｃ２ＤＥＦZＧ２４ ＨＪ	 　〃　　２　　〃 　２４〃　　
 お願いばかりですみませんが、宜しく検討お願いします｡
 (おや？)

 お返事遅くなりました。

 上記現象が再現されません。
 スペースの数など、異なるということはありませんか？
 (ROUGE)

 済みません、報告の仕方が間違ってました。
 以下の状況です。

 パラメータ
 文字列NO.１→何も無し、またはNO.２とは違うどんな文字でも
 文字列NO.２→_ＡＢ＿Ｃ２ＤＥＦZＧ２４ ＨＪ（_　＿はそれぞれ半角全角スペース）

 結果
 〃ＡＢ〃Ｃ２ＤＥＦZＧ２４〃ＨＪ
 となります。
　(おや？)

 これでどうでしょうか。
 (ROUGE)
'----
Function Oya(txt1 As String, txt2 As String, Optional num As Integer = 1)
    Dim i As Long, j As Long, k As Long, m As Long, n As Long, flg As Boolean, x() As String
    If Len(txt1) = 0 Or Len(txt1) > Len(txt2) Then: Oya = txt2: Exit Function
    ReDim x(1 To Len(txt2))
    For i = 1 To Len(txt2): x(i) = Mid(txt2, i, 1): Next
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(x)
            .Add x(i), Empty
            If .Exists(Mid(txt1, i, 1)) Then x(i) = IIf(LenB(StrConv(x(i), vbFromUnicode)) = 1, "半角", "全角")
            .RemoveAll
        Next
    End With
    For i = 1 To UBound(x)
        If flg Then
            If Not IsNumeric(Mid(txt2, i, 1)) Then
                flg = False: k = i - 1
                For j = n To k
                    If IsNumeric(x(j)) Then For m = n To k: x(m) = Mid(txt2, m, 1): Next: Exit For
                Next
            ElseIf i = UBound(x) Then
                For j = n To UBound(x)
                    If IsNumeric(x(j)) Then For m = n To UBound(x): x(m) = Mid(txt2, m, 1): Next: Exit For
                Next
            End If
        Else
            If IsNumeric(Mid(txt2, i, 1)) Then flg = True: n = i
        End If
    Next
    n = 0: flg = False
    For i = 1 To UBound(x)
        If Len(x(i)) > 1 Then
            If Not flg Then
                flg = True: n = i
                If i = UBound(x) Then x(i) = Mid(txt2, i, 1)
            End If
        Else
            If flg Then
                flg = False
                If n + num - 1 >= i Then m = i - 1: For j = n To m: x(j) = Mid(txt2, j, 1): Next
            End If
        End If
    Next
    n = 0: flg = False
    For i = 1 To UBound(x)
        If Len(x(i)) > 1 And Not flg Then
            If i <> UBound(x) Then
                n = i: flg = True
            Else
                x(i) = "〃"
            End If
        ElseIf (Len(x(i)) = 1 And flg) Or (i = UBound(x) And Len(x(i)) > 1 And flg) Then
            x((n + i - 1) \ 2) = "〃": flg = False
        End If
    Next
    For i = 1 To UBound(x)
        If Len(x(i)) > 1 Then x(i) = IIf(x(i) = "半角", " ", "　")
    Next
    Oya = Join(x, "")
End Function

 OKでした。すみませんが、最後に以下の２件ですが、
 ２）件目、ひょっとして今頃言うとプログラム変更大かも知れませんが
 ご検討宜しくお願いします｡

 １）
 文字列NO.１→ＡＢＣ２ＤＥＦZＧ２４ＨＪＫＬ	
 文字列NO.２→ＡＢＣ２ＤＥＦZＧ２４ＨＪ
 の様にNO.２が短い場合は
 ＡＢＣ２ＤＥＦZＧ２４ＨＪ
 と、NO.２をそのまま出したい。

 これは、頭から３行目に
    If Len(txt1) > Len(txt2) Then Oya = txt2: Exit Function
 を入れれば良いでしょうか。

 ２）
 文字列NO.１→ＡＢＣ２ＤＥＦZＧ２４ＨＪ	
 文字列NO.２→ＸＸＸＸＤＸＦZＸＸＸＸＸ
 の場合には、一致文字が続けて２文字以上ある場合のみ　〃　を
 表示する事としたい。

 ＸＸＸＸＤＸ〃 ＸＸＸＸＸ
 としたい。第3パラメータで２と設定すると上記の様になり、
 ０と設定すると今まで通り、１文字でも一致すれば　〃　と
 表示する。
 (おや？)

 直接コード修整しました。
 仕様変更にはこれ以上つきあえるかどうか、約束できません。
 不具合があったらお知らせ下さい。
 (ROUGE)

 大変お世話になります。後から仕様の見直し大変ご迷惑をおかけします。
 本件最後のお願いなのですが、第3パラメータで「〃」を表示する為の
 続けて？文字以上ある場合のみ本処理を実行させたいのですが、
 プログラムの　> 1　部分を > NN とでもして色々やってみましたが
 そうではない様です。大変申し訳ないのですがお願い致します｡
 (おや？)

 第3パラメータは見落としでした。
 直接修整しています。
 (ROUGE)

 ROUGEさん、大変有り難う御座いました。確認させて頂きました。OKです。
 これで、大変な手間が省けます。
 度重なる勝手な要望しましてご迷惑をおかけしました。
 (おや？)

コメント返信：

[ 一覧(最新更新順) ]

[[20070522160336]] 『文字列処理』（おや？） ページの最後に飛ぶ

[[20070522160336]]　『文字列処理』（おや？）　ページの最後に飛ぶ