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

質問する
マイページ

ログイン

<< 前の質問 | 次の質問 >>

解決済みの質問

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

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

よろしくお願いします。

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

通報する

QNo.9577248

sazanami0422

困ってます

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

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

回答を評価する （0）
通報する

ANo.2

watabe007

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

はい

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

-広告-
-広告-

回答（2）

ANo.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

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

回答を評価する （0）
通報する
-広告-
-広告-

あなたにオススメの質問

-広告-
-広告-

ページTOP