Excel2016 で値の合計の3個以上の表示

質問

1、セル範囲(M11:R19)に0～9の数値が空白も兼ねてのいずれかが各セルごとに入ります。
2、1での同じ数値の個数合計が3個以上の物をAL11からAU11に、最も個数が多い順から左詰めで入れたいです。空白はカウント無しです。

3、1の数値が消えて新しく空白を含めた数値がまた入るので、2に行きまして、AL11からAU11の値は消えずにこの下のAL12からAU12に2と同じ事をします。

どのようなソースになりますでしょうか。お願い致します。

回答No.2

kkkkkm · ベストアンサー

> このコロナ禍にお身体は大丈夫でしょうか？

おかげさまで大丈夫みたいです。961awaawaさんもお変わりありませんか？

> このついでになんですが質問させて頂けますか？

この件については解決しているようですので、質問は新たに別で投稿してください。

回答No.1

kkkkkm

以下で試してみてください。

Sub Test()
Dim i As Integer
Dim buf(0 To 9) As Integer
Dim mRow As Long
Dim kRange As Range
Dim sRange As Range

With Worksheets("Sheet1")
If .Range("AL11") <> "" Then
mRow = .Cells(Rows.Count, "AL").End(xlUp).Row + 1
Else
mRow = 11
End If
For i = 0 To 9
buf(i) = WorksheetFunction.CountIf(.Range("M11:R19"), i)
If buf(i) >= 3 Then
.Cells(mRow, "AL").Offset(0, i).Value = i
.Cells(mRow, "AL").Offset(1, i).Value = buf(i)
End If
Next
Set kRange = Range(.Cells(mRow + 1, "AL"), .Cells(mRow + 1, "AU"))
Set sRange = Range(.Cells(mRow, "AL"), .Cells(mRow + 1, "AU"))
With .Sort
.SortFields.Clear
.SortFields.Add Key:=kRange, _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
.SetRange sRange
.Orientation = xlLeftToRight
.Apply
End With
.Cells(mRow + 1, "AL").Resize(1, 10).ClearContents
End With
Set kRange = Nothing
Set sRange = Nothing
End Sub

お礼

お久しぶりですkkkkkmさん。このコロナ禍にお身体は大丈夫でしょうか？
バッチしできました。ありがとうございます。
このついでになんですが質問させて頂けますか？