>その数字のセルを塗潰し
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

投稿日時 - 2019-01-13 14:16:58