重複数字の塗潰しとその結果をまとめるには？

質問

いつもお世話になっております。
ご回答頂けたらありがたいです。
添付図の様に６×７のセルが５つあります。
１~３７迄の数字が重複有りで入っています。
重複が２個、３個、４個あれば、黄色、緑色、赤色で
その数字のセルを塗潰し、最後にまとめとして、
実際に重複した数字を右側に左から昇順で並べるにはどうすればよいですか？
尚、最大重複は４個迄とします。

よろしくお願いします。

回答No.2

watabe007 · ベストアンサー

>その数字のセルを塗潰し
Sub Test2()
　Dim r As Long, n As Long, m As Long, c As Range
　For r = 2 To 30 Step 7
　　For n = 1 To 50
　　　m = Application.CountIf(Cells(r, "A").Resize(6, 7), n)
　　　If m >= 2 Then
　　　　Cells(r + m - 2, Columns.Count).End(xlToLeft).Offset(, 1).Value = n
　　　End If
　　Next
　　For Each c In Cells(r, "A").Resize(6, 7)
　　　m = Application.CountIf(Cells(r, "A").Resize(6, 7), c.Value)
　　　If m >= 2 Then
　　　　Select Case m
　　　　　Case 2: c.Interior.Color = vbYellow
　　　　　Case 3: c.Interior.Color = vbGreen
　　　　　Case 4: c.Interior.Color = vbRed
　　　　End Select
　　　End If
　　Next
　Next
End Sub

お礼

早速の回答いただきありがとうございます。
綺麗に分類できるようになりました。

回答No.1

watabe007

Sub Test()
　Dim r As Long, n As Long, m As Long
　For r = 2 To 30 Step 7
　　For n = 1 To 50
　　　m = Application.CountIf(Cells(r, "A").Resize(6, 7), n)
　　　If m >= 2 Then
　　　　Cells(r + m - 2, Columns.Count).End(xlToLeft).Offset(, 1).Value = n
　　　End If
　　Next
　Next
End Sub