こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

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

よろしくお願いします。

投稿日時 - 2019-01-13 13:18:51

QNo.9577248

困ってます

質問者が選んだベストアンサー

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

お礼

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

投稿日時 - 2019-01-13 15:58:37

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

-広告-
-広告-

回答(2)

ANo.1

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

投稿日時 - 2019-01-13 13:52:59

-広告-
-広告-

あなたにオススメの質問

-広告-
-広告-