Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


23447 / 76738 ←次へ | 前へ→

【58657】Re:同じ文字列の検索
発言  kanabun  - 08/11/3(月) 11:36 -

引用なし
パスワード
   ▼板さん さん:

何か非常に面白い問題だけれど、同時に、
非常に難しい問題ですね(-_-)

手始めに、A列のデータ(コード)について、どうグループ化するかを
VBA風に考えてみます。

A列データを1次元配列に格納し、
検索条件として
(1)A列のコードが文字列で、かつ、先頭1文字が「0か1」のばあい
  先頭1文字を取り除き、
(2)文字数が5〜7のとき、
という条件で、配列全体からこれを含むコードを
 VBA.Filter関数で抽出してみますと、

Sub Try1()
  Dim ColA As Range
  Dim v, w
  Dim ss As String
  Dim i As Long
  
  Set ColA = Range("A2", Cells(Rows.Count, 1).End(xlUp))
  v = Application.Transpose(ColA)  '------- A列を配列に
  For i = 1 To UBound(v)
    ss = v(i)
    If Not IsNumeric(ss) Then
      If InStr("01", Left$(ss, 1)) Then ss = Mid$(ss, 2)
    End If
    Select Case Len(ss)
      Case 5 To 7
        w = Filter(v, ss)
        If IsArray(w) Then
          Debug.Print "[" & ss & "]", Join(w, ",")
        End If
    End Select
  Next
  
End Sub

結果、こうなります。
--------------------------------------
'[12345]    12345,012345a
'[12345a]   012345a
'[987a654]   987a654,1987a65400
'[23456]    23456,23456aa,23456a
'[23456aa]   23456aa
'[23456a]   23456aa,23456a


'重複しているコードをグループ化する
Sub Try2()
  Dim ColA As Range
  Dim v, w, key
  Dim ss As String, sss As String
  Dim i As Long, j As Long, k As Long, ok As Long
  
  Set ColA = Range("A2", Cells(Rows.Count, 1).End(xlUp))
  v = Application.Transpose(ColA)
  For i = 1 To UBound(v)
    ss = v(i)
    If Not IsNumeric(ss) Then
      If InStr("01", Left$(ss, 1)) Then ss = Mid$(ss, 2)
    End If
    Select Case Len(ss)
      Case 5 To 7
        ok = 1
        For j = 5 To Len(ss)
          If InStr(sss, Left$(ss, j)) Then ok = 0: Exit For
        Next
        If ok Then sss = sss & "|" & ss
    End Select
  Next i
  For Each key In Split(Mid$(sss, 2), "|")
    w = Filter(v, key)
    Debug.Print "[" & key & "]", Join(w, ",")
  Next
  
End Sub

すると、このサンプルでは 結果はこうなります。
-----------------------------------
'[12345]    12345,012345a
'[987a654]   987a654,1987a65400
'[23456]    23456,23456aa,23456a

しかしこれは keyとなるコードが文字列数の少ないほうから
出現していたからです

つぎのような並び順の場合、
---------------------------
 コード
 1987a65400
 987a654
 23456aa
 23456a
 12345a
 23456
 12345

結果はこうなります。

------------------------------------
[987a654]   1987a65400,987a654
[23456aa]   23456aa
[12345a]   012345a

'これは失敗です。
検索コードグループ文字列は 最短一致するkeyに置き換えねばなりません。

Sub Try3()
  Dim ColA As Range
  Dim v, w, key
  Dim s As String, ss As String, sss As String
  Dim i As Long, k As Long
  
  Set ColA = Range("A2", Cells(Rows.Count, 1).End(xlUp))
  v = Application.Transpose(ColA)
  For i = 1 To UBound(v)
    ss = v(i)
    If Not IsNumeric(ss) Then
      If InStr("01", Left$(ss, 1)) Then ss = Mid$(ss, 2)
    End If
    Select Case Len(ss)
      Case 5 To 7
        Distribute sss, ss
    End Select
  Next i
  For Each key In Split(Left$(sss, Len(sss) - 1), "|")
    w = Filter(v, key)
    Debug.Print "[" & key & "]", Join(w, ",")
  Next
  
End Sub

Private Sub Distribute(sss$, ss$)
  Dim ok%, j&, j1&, j2&, s$, zz$
  ok = 1
  For j = 5 To Len(ss)
    s = Left$(ss, j)
    j1 = InStr(sss, s)
    If j1 Then
      j2 = InStr(j1 + Len(s), sss, "|")
      zz = Mid$(sss, j1, j2 - j1)
      sss = Replace(sss, zz, s)
      ok = 0
      Exit For
    End If
  Next
  If ok Then sss = sss & ss & "|"
End Sub

これを同じデータで実行すると、こうなります。
-------------------------------------
'[987a654]   1987a65400,987a654
'[23456]    23456aa,23456a,23456
'[12345]    012345a,12345

ここまでの思考過程を把握するには、提示のような簡単なデータをシートに
おいて、ステップ実行してみて、1行づつ実行しながら、変数が変わっていく
状態をトレースするといいです。

分からない点がございましたら、レスください。
1 hits

【58651】同じ文字列の検索 板さん 08/11/2(日) 23:32 質問
【58652】Re:同じ文字列の検索 kanabun 08/11/2(日) 23:42 発言
【58653】Re:同じ文字列の検索 板さん 08/11/3(月) 7:25 質問
【58657】Re:同じ文字列の検索 kanabun 08/11/3(月) 11:36 発言
【58658】Re:同じ文字列の検索 kanabun 08/11/3(月) 15:45 発言
【58660】Re:同じ文字列の検索 板さん 08/11/3(月) 18:14 お礼
【58661】Re:同じ文字列の検索 kanabun 08/11/3(月) 18:20 発言
【58662】Re:同じ文字列の検索 kanabun 08/11/3(月) 18:35 発言
【58663】Re:同じ文字列の検索 kanabun 08/11/3(月) 22:33 発言
【58664】Re:同じ文字列の検索 板さん 08/11/4(火) 0:14 お礼

23447 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free