| |
▼chou さん：
>追加の質問をよろしいでしょうか。
理解しないまま、追加要望だしても
余計にわからなくなるだけだと思いますよ。
Sub test2()
Dim tbl As Range
Dim rng As Range
Dim constAreas As Areas
Dim blankAreas As Areas
Dim r As Range
Dim k As Long
Dim c As Range
Columns(5).Insert
Set tbl = Range("A1").CurrentRegion
tbl.Columns(5).FormulaR1C1 = "=rc[-2]&""_""&rc[-1]"
Set rng = tbl.Columns(6)
Set constAreas = rng.SpecialCells(xlCellTypeConstants).Areas
Set blankAreas = rng.SpecialCells(xlCellTypeBlanks).Areas
Set c = Range("Z1") 'どこか離れた場所を作業用に使用（統合先）
For Each r In constAreas
c.Consolidate r.Offset(, -1).Resize(, 2).Address(, , xlR1C1), xlSum, False, True
c.CurrentRegion.Sort c.Columns(2), xlDescending
k = k + 1
If c.Offset(, 1).Value = c.Offset(1, 1).Value Then
MsgBox blankAreas(k).Offset(, -5).Value & "の数字が同じです。"
Else
blankAreas(k).Offset(, -3).Resize(, 2).Value = Split(c.Value, "_")
End If
c.CurrentRegion.ClearContents
Next
Columns(5).Delete
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
