マクロ作成方法 8 (N4ﾎﾞｯｸｽ後追い数字集計(重複無))

2018/03/18 17:59

マクロ作成方法 7　の　N4ﾎﾞｯｸｽ後追い数字(重複有)）を元に考えます。
マクロ作成方法 7（N4ﾎﾞｯｸｽ後追い数字集計(重複有)）

重複有る部分の判断と、その結果から計算方法を考えれば良いですね。

上の表の様に1~4のパターンが出て来ますが、各パターンでの対応を考えて行きます。

たとえばシングルが出て次もシングルなら4×4で16通りの計算になります。

ダブルからダブルなら重複無で考えたなら3×3で9通りですが、シングルと同じと考えて

16通り計算します。ただし重複部の計算はしないようにします。

（注）同じ番号同志での後追い集計は引っ張り集計にもなります。

（別の考え方もあると思いますが、複雑になりそうなので今回は簡単な方法で）

　　　　　　　＜N4ボックス後追い数字集計（重複無）＞

4つの数字をカウントして重複の有無を判断し計算するマクロ

Countifを使い前の番号と後の番号の2番目から4番目の数字が重複しているかを調べま

す。　（1番目は重複無なので　1,2　1,2,3　1,2,3,4　下線の番号をチェック　）

前の番号、後の番号どちらかまたは両方重複していたら、それに応じた計算にします。

Cells(5 + ya, 245 + xa) = Cells(5 + ya, 245 + xa) + p の集計で重複無の時Pを1とし、

重複有の時は　Pを0とし（mとnから）計算結果に変化が無いようにしています。

（P=m*ｎで判別　ｍｎとも1で重複無の計算、それ以外は重複有の計算）

　m＝1,n=1----重複無の時の条件とする（p=1）。　　

　m＝1と n=0 、 m=0と n=1 、 m=0とn=0 ------重複有の時の条件とする（p=0）。　　

**********************************************************************************************
変数　知らなかった本当の使い方
Sub n4bx_ato_oi_tyonon() 'Ｎ4ボックス後追い集計（重複無での計算）

Dim xa, ya, i, ii, iii, m, n, p As Integer

Sheets("出現数").Select

Range("ik5:it14").Select
    Selection.ClearContents　’データ出力部のクリア


    Call saikeisanoff '再計算等停止マクロ作成方法 1　と同様

i = 5　’5行目から

Do Until Sheets("ｽﾄﾚｰﾄﾊﾟﾀｰﾝ").Cells(i, 3) = ""

For ii = 4 To 7 '前の番号の4列から7列のデータ処理

          xa = Sheets("ｽﾄﾚｰﾄﾊﾟﾀｰﾝ").Cells(i - 1, ii) '前の数字（i - 1）
          m = 1　’重複無とする（最初の数字は重複は無いので）

       If ii >= 5 Then '5、6、7で同じ数字(重複有)があればmを0とし無ければmを1とする。

          If WorksheetFunction.CountIf(Range(Sheets("ｽﾄﾚｰﾄﾊﾟﾀｰﾝ").Cells(i - 1, 4), Sheets("ｽﾄﾚｰﾄﾊﾟﾀｰﾝ").Cells(i - 1, ii)), Sheets("ｽﾄﾚｰﾄﾊﾟﾀｰﾝ").Cells(i - 1, ii)) = 1 Then
               m = 1　’重複無とする　カウントして1なら
          Else
           　 m = 0　’重複有とする　カウントして2以上なら
          End If

       End If


     For iii = 4 To 7   '後の番号の4列から7列のデータ処理

           ya = Sheets("ｽﾄﾚｰﾄﾊﾟﾀｰﾝ").Cells(i, iii) '後の数字
           n = 1　’重複無とする（最初の数字なので）

        If iii >= 5 Then '5、6、7で同じ数字（重複有）があればnを0とし無ければnを1とする。

          If WorksheetFunction.CountIf(Range(Sheets("ｽﾄﾚｰﾄﾊﾟﾀｰﾝ").Cells(i, 4), Sheets("ｽﾄﾚｰﾄﾊﾟﾀｰﾝ").Cells(i, iii)), Sheets("ｽﾄﾚｰﾄﾊﾟﾀｰﾝ").Cells(i, iii)) = 1 Then
             n = 1　’重複無とする
          Else
             n = 0　’重複有とする

          End If

        End If


          p = m * n 'm,nが1ならｐは1、それ以外はｐは0　関係表のパターンに対応。

          Cells(5 + ya, 245 + xa) = Cells(5 + ya, 245 + xa) + p '重複有（0）無（1）での集計

     Next iii

   Next ii

   i = i + 1

Loop

Call saikeisanon '再計算等をする

       Range("ik5:it14").Select '自動記録マクロでik5:it14のセル範囲を条件塗りつぶし

    Selection.FormatConditions.AddAboveAverage
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).AboveBelow = xlAboveAverage
    With Selection.FormatConditions(1).Font
        .Color = -16752384
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13561798
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.AddAboveAverage
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).AboveBelow = xlBelowAverage
    With Selection.FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False



   Cells(1, 243).Select
   Cells(1, 243) = i - 4 & " 回"　’最終回号表示する

End Sub