| |
▼fool さん：
パターンごとの集計をSheetに列記する例を作ってみました。
予想に反し計算時間はそれほど掛かりませんがデータ個数20で
メモリ不足となります。
格納方法の工夫が必要ですね。
尚、数値→２進数、２進数→数値は
ｈｔｔｐ://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初心者の自分には敷居が高すぎて困っております。
>お手数ですが、ご教示のほどをよろしくお願いいたします。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
