Excel VBA質問箱 IV

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

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


3349 / 13644 ツリー ←次へ | 前へ→

【62767】連続したセルのパターンの個数を調べるには fool 09/8/31(月) 8:55 質問[未読]
【62769】Re:連続したセルのパターンの個数を調べる... もも 09/8/31(月) 11:16 発言[未読]
【62771】Re:連続したセルのパターンの個数を調べる... SS 09/8/31(月) 11:53 発言[未読]
【62772】Re:連続したセルのパターンの個数を調べる... もも 09/8/31(月) 13:08 発言[未読]
【62770】Re:連続したセルのパターンの個数を調べる... Yuki 09/8/31(月) 11:46 発言[未読]
【62773】Re:連続したセルのパターンの個数を調べる... SS 09/8/31(月) 13:58 発言[未読]
【62774】Re:連続したセルのパターンの個数を調べる... 超初心者 09/8/31(月) 14:30 発言[未読]
【62778】Re:連続したセルのパターンの個数を調べる... fool 09/9/1(火) 1:38 お礼[未読]

【62767】連続したセルのパターンの個数を調べるに...
質問  fool  - 09/8/31(月) 8:55 -

引用なし
パスワード
   皆様、お忙しいところ申し訳ありません。

恐れ入りますが、下記のようなパターンを調べたい場合、
どのようにマクロを作成すれば良いかお教えいただけますでしょうか。

A B
1 1
2 0
3 1
4 1
5 0
6 0
7 1
8 0
9 1
・ ・
・ ・

↑上記のようにB列にランダムに1と0が並んでいる場合を考えます。
この時、"101"や"01001"など、様々な0と1の組み合わせパターンについて、
個数を数えるVBAを作成したいと考えております。

COUNTIFだと連続するセルの個数などを調べるには無力ですし、
VBA初心者の自分には敷居が高すぎて困っております。
お手数ですが、ご教示のほどをよろしくお願いいたします。

【62769】Re:連続したセルのパターンの個数を調べ...
発言  もも  - 09/8/31(月) 11:16 -

引用なし
パスワード
   ▼fool さん:
こんにちは

こんな感じでどうですか?

Sub test()
Const myStr As String = "101" '探す文字
Dim myCount As Long
myCount = UBound(Split(Join(Application.Transpose(Range("B1", Range("B1").End(xlDown)).Value), ""), myStr))
MsgBox myStr & "は" & myCount & "個です"
End Sub

【62770】Re:連続したセルのパターンの個数を調べ...
発言  Yuki  - 09/8/31(月) 11:46 -

引用なし
パスワード
   ▼fool さん:
こんな感じでは


Sub TEST_Pattrn()
  Dim varD  As Variant
  Dim varR  As Variant
  Dim strF  As String
  Dim i    As Long
  Dim j    As Long
  Dim strMsg As String
  
  strF = "101"  ' 検索値
  varD = Range("B1").Resize(Range("B" & Rows.Count).End(xlUp).Row).Value
  varD = Application.Transpose(varD)
  varD = Join(varD, "")
  
  ' パターン1
  '1001101101011' の時
  '  xxxyyy
  varR = Split(varD, strF)  '2個
  strMsg = "パターン1は " & UBound(varR) & "個 " & vbCrLf
  
  ' パターン2
  '1001101101011' の時
  '  xxxyyy
  '     zzz
  j = 1
  i = 0
  Do
    j = InStr(j, varD, strF)
    If j = 0 Then Exit Do
    i = i + 1
    j = j + 1
  Loop
  strMsg = strMsg & "パターン2は " & i & "個"
  MsgBox strMsg
End Sub

【62771】Re:連続したセルのパターンの個数を調べ...
発言  SS  - 09/8/31(月) 11:53 -

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

こんにちは、横から失礼します。
ももさんの案では以下の並びのときに問題が出そうです。
A    B
1    1
2    0
3    1
4    0
5    1
6    0
7    1
8    0
9    1
やはりしらみつぶしに調べるしか方法はないのではないでしょうか。
Sub test2()
  Const myStr As String = "101" '探す文字
  Dim AA As Variant
  Dim tmpStr As String
  Dim lastR As Long, i As Long, C As Long
  
  lastR = Range("B" & Rows.Count).End(xlUp).Row
  AA = Range("B1:B" & lastR).Value
  C = 0
  For i = 1 To lastR + 1 - 3 '(3文字の場合)
    tmpStr = AA(i, 1) & AA(i + 1, 1) & AA(i + 2, 1)
    If tmpStr = myStr Then C = C + 1
  Next i
  MsgBox myStr & "は" & C & "個です"
End Sub
ただしこれ考えられる全パターンとなると2^(n+1)-2個あり
計算量的にきついことになるのではないでしょうか?

>こんにちは
>
>こんな感じでどうですか?
>
>Sub test()
>Const myStr As String = "101" '探す文字
>Dim myCount As Long
>myCount = UBound(Split(Join(Application.Transpose(Range("B1", Range("B1").End(xlDown)).Value), ""), myStr))
>MsgBox myStr & "は" & myCount & "個です"
>End Sub

【62772】Re:連続したセルのパターンの個数を調べ...
発言  もも  - 09/8/31(月) 13:08 -

引用なし
パスワード
   ▼SS さん:
>▼fool さん:
>▼もも さん:
>
>こんにちは、横から失礼します。
>ももさんの案では以下の並びのときに問題が出そうです。

そうですね。
Yukiさんの回答のパターン2もそれを考慮しての事だと思いますが
質問の中で目的やイレギュラーパターンなどの説明が無かったので
とりあえず、方法の1つを示させて頂きました。

フォローありがとうございます。

【62773】Re:連続したセルのパターンの個数を調べ...
発言  SS  - 09/8/31(月) 13:58 -

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

パターンごとの集計をSheetに列記する例を作ってみました。
予想に反し計算時間はそれほど掛かりませんがデータ個数20で
メモリ不足となります。
格納方法の工夫が必要ですね。
尚、数値→2進数、2進数→数値は
http://okwave.jp/qa5200.htmlよりお借りしています。

Sub test3()
  Dim AA As Variant
  Dim BB As Variant
  Dim tmpStr As String
  Dim lastR As Long
  Dim i As Long, j As Long, k As Long, m As Long, C As Long
  
  lastR = Range("B" & Rows.Count).End(xlUp).Row
  AA = Range("B1:B" & lastR).Value
  ReDim BB(lastR, 2 ^ lastR)
  For j = 1 To lastR
    For i = 1 To lastR + 1 - j
      tmpStr = ""
      For k = 0 To j - 1
        tmpStr = tmpStr & AA(i + k, 1)
      Next k
      
      C = Bin2Num(tmpStr)
      BB(j, C) = BB(j, C) + 1
    Next i
  Next j
  For j = 1 To lastR
    For i = 0 To 2 ^ lastR
      If BB(j, i) > 0 Then
        m = m + 1
        Cells(m, 3).Value = "'" & Num2Bin(i, j - 1)
        Cells(m, 4).Value = BB(j, i)
      End If
    Next i
  Next j

End Sub

'数値→2進
Public Function Num2Bin(Value As Variant, n As Long) As Variant
  Dim NVal As Long
  Dim i As Long
  If IsNumeric(Value) = False Then
    Num2Bin = 0
    Exit Function
  End If
  NVal = Val(Value)
  For i = n To 0 Step -1
    Num2Bin = Num2Bin & ((NVal And 2 ^ i) / (2 ^ i))
  Next i
End Function

'2 進→数値
Public Function Bin2Num(Value As Variant) As Variant
  Dim i As Long
  Dim StrVal As String
  Dim Cursor As Long
 
  If IsNumeric(Value) = False Then
    Bin2Num = 0
    Exit Function
  End If
  StrVal = CStr(Value)
 
  Cursor = 0
  For i = Len(StrVal) To 1 Step -1
    Select Case Mid$(StrVal, i, 1)
      Case "0"
        Bin2Num = Bin2Num + 0
      Case "1"
        Bin2Num = Bin2Num + (2 ^ Cursor)
      Case Else
        Bin2Num = 0
        Exit Function
    End Select
    Cursor = Cursor + 1
  Next i
End Function


>皆様、お忙しいところ申し訳ありません。
>
>恐れ入りますが、下記のようなパターンを調べたい場合、
>どのようにマクロを作成すれば良いかお教えいただけますでしょうか。
>
>A B
>1 1
>2 0
>3 1
>4 1
>5 0
>6 0
>7 1
>8 0
>9 1
>・ ・
>・ ・
>
>↑上記のようにB列にランダムに1と0が並んでいる場合を考えます。
>この時、"101"や"01001"など、様々な0と1の組み合わせパターンについて、
>個数を数えるVBAを作成したいと考えております。
>
>COUNTIFだと連続するセルの個数などを調べるには無力ですし、
>VBA初心者の自分には敷居が高すぎて困っております。
>お手数ですが、ご教示のほどをよろしくお願いいたします。

【62774】Re:連続したセルのパターンの個数を調べ...
発言  超初心者  - 09/8/31(月) 14:30 -

引用なし
パスワード
   ▼fool さん:
既にいくつも出ているので、あまりたくさん出すと
混乱されるかもしれませんが、
せっかく考えたので、一応載せておきます^^;


Private Sub sample()
  Dim myDic As Object
  Dim myN As Long
  Dim myRow As Long
  Dim myLooP As Long
  Dim myLooQ As Long
  Dim myTmp As Variant
  
  
  myRow = Range("B" & Cells.Rows.Count).End(xlUp).Row
  Set myDic = CreateObject("Scripting.Dictionary")
  
  Do Until myN = myRow
    For myLooP = 1 To myRow - myN
      myTmp = ""
      For myLooQ = 0 To myN
        myTmp = myTmp & Cells(myLooP + myLooQ, 2).Value
      Next myLooQ
      myDic(myTmp) = myDic(myTmp) + 1
    Next myLooP
    myN = myN + 1
  Loop
  
  myTmp = myDic.Keys
  
  Debug.Print "パターン別個数"
  For myLooP = LBound(myTmp) To UBound(myTmp)
    Debug.Print myTmp(myLooP), myDic(myTmp(myLooP))
  Next myLooP
  Debug.Print "全パターン数 : ", UBound(myTmp) + 1
  
  Set myDic = Nothing
End Sub

結果はイミディエイトウィンドウに出力します。
(・・・ので、件数多いと最初が消えるかも)
一応、データ100個までテストしてみました^^

参考までに。。。

【62778】Re:連続したセルのパターンの個数を調べ...
お礼  fool  - 09/9/1(火) 1:38 -

引用なし
パスワード
   >>ももさん、SSさん、Yukiさん、超初心者さん

投稿者のfoolです。
昨日の朝に投稿して、仕事から帰って掲示板を見たら、
こんなにたくさんのレスがついていて驚きました。

アホな自分のためにアドバイスありがとうございます・・・。
皆様方の優しさに感動しました。本当にありがとう!!
m(_ _)mペコリ

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