同じ数字を2個使用している重複行の数字の出力方法2

質問

いつも大変お世話になっております。
どなたかご存じの方がお見えでしたら回答頂けると幸いです。
【質問】
2019/12/20 22:51に質問No.9692415として
『同じ数字を2個使用している重複行の数字の出力方法』という質問をさせて頂き、
nishi6様から回答を頂きました。
動作としては添付図のとおり５列×２０行の数字の中から、２個の数字が重複していたら黄色でセルを塗り潰し、重複する行に重複した行を、実際に重複した２個の数字をＨ列～ＡＡ列に書き出します。）この時の質問から発展して、『同じ数字を２個使用している重複行の数字の出力方法2』が今回の質問です。
具体的には下記２つです。
(1)重複数字１～重複数字１０の２列×２０行の数字をＡＢ列・ＡＣ列に縦に並べた後、昇順に並び変えて重複数字を削除する。
(2)重複数字１～重複数字１０の２列×２０行の数字をＡＥ列のみに縦に並べた後、
　昇順に並び変えて重複数字を削除する。（又は、（１）で重複数字が削除された数字をＡＥ列に1列に並べた後、昇順に並び変えて重複数字を削除する。）

以上、よろしくお願いします。

回答No.2

SI299792 · ベストアンサー

Option Explicit
Option Base 1
'
Sub Macro1()
　　Dim Cell As Range
　　Dim Points(2 To 21, 31) As Integer
　　Dim Row1 As Integer
　　Dim Row2 As Integer
　　Dim Col1 As Integer
　　Dim Col2 As Integer
　　Dim RowO As Integer
　　Dim Index As Integer
　　Dim Count As Integer
　　Dim Col1S(5) As Integer
　　Dim Col2S(5) As Integer
'
　　[B:F].Interior.Pattern = xlNone
　　[G2:AE32767].ClearContents
'
　　For Each Cell In [B2:F21]
　　　　Points(Cell.Row, Cell) = Cell.Column
　　Next Cell
'
　　For Row1 = 2 To 21
'
　　　　For Row2 = Row1 To 21
　　　　　　Count = 0
'
　　　　　　For Index = 1 To 31
　　　　　　　　Col1 = Points(Row1, Index)
　　　　　　　　Col2 = Points(Row2, Index)
'
　　　　　　　　If Col1 > 0 And Col2 > 0 Then
　　　　　　　　　　Count = Count + 1
　　　　　　　　　　Col1S(Count) = Col1
　　　　　　　　　　Col2S(Count) = Col2
　　　　　　　　End If
　　　　　　Next Index
'
　　　　　　If Count = 2 Then
　　　　　　　　ColorPoint Row1, Row2, Col1S(1), Col1S(2)
　　　　　　　　ColorPoint Row2, Row1, Col2S(1), Col2S(2)
　　　　　　　　RowO = RowO + 1
　　　　　　　　Col1 = Col1S(1)
　　　　　　　　Col2 = Col1S(2)
　　　　　　　　Col1 = Cells(Row1, Col1)
　　　　　　　　Col2 = Cells(Row1, Col2)
　　　　　　　　Cells(RowO, "AB") = Col1
　　　　　　　　Cells(RowO, "AC") = Col2
　　　　　　　　Cells(Col1, "AE") = Col1
　　　　　　　　Cells(Col2, "AE") = Col2
　　　　　　End If
　　Next Row2, Row1
　　Range("AB1:AC" & RowO).Sort KEY1:=[AB1]
　　[AE1:AE31].Sort KEY1:=[AE1]
End Sub
'
Sub ColorPoint(RowA As Integer, RowB As Integer, ColA As Integer, ColB As Integer)
　　Dim BData As String
　　Dim ColO As Integer
'
　　BData = Cells(RowA, "G")
　　ColO = BData <> ""
　　Cells(RowA, "G") = "'" & BData & Left(",", -ColO) & RowB - 1
　　Cells(RowA, ColA).Interior.Color = vbYellow
　　Cells(RowA, ColB).Interior.Color = vbYellow
　　ColO = Cells(RowA, "AA").End(xlToLeft).Column
　　Cells(RowA, ColO + 1) = Cells(RowA, ColA)
　　Cells(RowA, ColO + 2) = Cells(RowA, ColB)
End Sub

お礼

大変助かりました。
ありがとうございました。

回答No.1

imogasi

下記やってみたが、ピント外れならすみません．無視してください。
＝＝＝
・データ例は質問の画像と同じデータでテスト。
Ｓｈｅｅｔ１の　Ａ２：Ｅ２１（Ａ１からでない。特に意味なし））
・標準モジュールに
Sub test02()
Set sh1 = Worksheets("Sheet3")　’インプットデータ
Set sh2 = Worksheets("Sheet4")　’アウトプット
'--
k = 1
For i = 2 To 21
'----
For c1 = 1 To 5
For c2 = 1 To 5
If c1 < c2 Then
sh2.Cells(k, 1) = "'" & Format(sh1.Cells(i, c1), "00") & "-" & Format(sh1.Cells(i, c2), "00")
sh2.Cells(k, 2) = "'" & (i - 1)
k = k + 1
End If
Next c2
Next c1
'---
Next i
End Sub
ーーー
結果　略　自分の実行結果を見てください。
ーーー
・Ｓｈｅｅｔ４のＡ列（第Iキー）－Ｂ列（第２キー）でソート　
（ＶＢＡでもできるが今回は手動の、データー並べ替えで処理）
Ｓｈｅｅｔ４の上５行例示します。
参考
Ａ列　　Ｂ列
01-02 2
01-02 19
01-03 2
01-03 14
01-05 14
以下略
ちなみに、例えば、１を０１などと表現しているのは、後のソートのことを
考えてです。
ーー
重複分を抜出し。直前行と同じなら抜出ししている。
Sub test03()
Set sh1 = Worksheets("Sheet4")　'ソート後
Set sh2 = Worksheets("Sheet5")　’結果
k = 1
lr = sh1.Range("A100000").End(xlUp).Row
MsgBox lr
mae = sh1.Cells(1, "A")
For i = 2 To lr
If sh1.Cells(i, "A") = mae Then
sh2.Cells(k, "A") = sh1.Cells(i, "A")
sh2.Cells(k, "B") = sh1.Cells(i - 1, "B")
sh2.Cells(k, "C") = sh1.Cells(i, "B")
k = k + 1
Else
End If
mae = sh1.Cells(i, "A")
Next i
End Sub
ーー
結果　Ｓｈｅｅｔ５
Ａ列　　Ｂ列　Ｃ列
数字の組　　下記行と行に出現
01-02 2 19
01-03 2 14
01-15 9 19
01-17 2 19
02-17 2 19
03-11 11 14
03-12 2 20
03-21 11 20
05-10 12 14
06-09 8 15
06-22 1 15
06-30 1 15
07-16 16 20
08-12 7 13
09-17 8 19
09-20 3 15
11-29 4 6
11-30 6 11
12-16 7 20
16-18 5 16
17-18 8 16
19-27 9 18
20-22 10 15
22-29 6 10
22-30 1 6
22-30 6 15
25-26 4 17
26-27 4 18
ーー
これをＳｈｅｅｔ３の、原データにどう纏める（関連付けて表現する）のか
質問では、小生は分らなかったから、ここまでにした。
ーーー
元データのあり様がら、どういう思考過程（処理ロジック）で
本件を考えた結果で、少数例示をして、そして結果がこうなるという
読者向け、説明が必要だろうと思う。
ーーー
質問には、画像データでなく
4.6.15.22.30
1.2.3.12.17
8.9.13.20.21
11.25.26.27.29
16.18.19.28.31
11.22.23.29.30
4.8.12.16.25
6.9.17.18.26
1.13.15.19.27
2.20.22.28.29
3.11.21.30.31
5.7.10.14.24
5.8.12.15.29
1.3.5.10.11
6.9.20.22.30
7.13.16.17.18
2.21.24.25.26
10.19.23.26.27
1.2.9.15.1７
3.7.12.16.21
のようなデータを質問文に載せてくれれば、
読者は、自分のシートにコピペして、
データー区切り位置でシートのデータが早く作れる。
画像を見て自分のシートにデータを作るのは、手間がかかると思いませんか。
ーー
これは一体、何のデータですか。
丸投げ的に質問しているが、ただ回答者は
やらされ感が強い。パズルか？ＲＯＴ？
前質問から少しずつ、結果内容をずらして、何度も質問しているが
またか感が強い。
ーー
まず質問者は、処理ロジックを考えるのが、肝心と思う。
（本件は組み合わせとソート法ですが。あまり良いとは思ってない。
３組の文字になったら複雑になってお手上げ。）
そういう話は一切出てないが、まず数学関連のカテゴリに
質問して、良いアイデアと方法を教えてもらったら。
エクセルやプログラムはそのあとのことだ。

お礼

回答頂きありがとうございました。