| |
▼smasa さん：
>
>重複した数字がある行を判別してグループにし、
>結果をN列に表示したいのですが。
>お力をお貸しいただけないでしょうか？
>
>結果的には、下の例のように、G5：K10までの範囲にある数字を
>以下のようにN列に表示したいのです。
>
>>> G H I J K ... M N
>>> 5 1 1,2,3,4
>>> 6 2 3 1,2,3,4
>>> 7 5 5,6
>>> 8 3 4 1,2,3,4
>>> 9 1 2 1,2,3,4
>>>10 5 6 5,6
>>>11
>
>行方向は空白セルでとまるようにします。(例の場合は10まで)
>
>もともとは下のように数字が入力されています。
>（1番左は行番号です）
>
> 列
>>> G H I J K ... M N
>>> 5 1
>>> 6 2 3
>>> 7 5
>>> 8 3 4
>>> 9 1 2
>>>10 5 6
>
上記のデータだとして
こんな感じですか？
Option Explicit
Sub Macro1()
Dim eRow As Long
Dim v As Variant
Dim i As Long
Dim j As Long
Dim x As Long
Dim A() As Variant
Dim rng As Range
Dim D As Variant
eRow = Range("G" & Rows.Count).End(xlUp).Row
Set rng = Range("N1:N" & eRow)
rng.Cells(1) = 1
rng.DataSeries xlColumns
Set rng = Nothing
Set rng = Range("G1:N" & eRow)
rng.Sort Key1:=Range("G2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin, DataOption1:=xlSortNormal
v = Range("G2:K" & eRow).Value
rng.Sort Key1:=Range("L2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin, DataOption1:=xlSortNormal
Columns(14).ClearContents
For i = 1 To UBound(v)
If v(i, 2) = Empty Then
x = x + 1
ReDim Preserve A(1 To x)
A(x) = v(i, 1)
Else
For j = 1 To UBound(v, 2)
If v(i, j) = Empty Then Exit For
' 連番の時の処理
If v(i, j) = Split(A(x), ",")(UBound(Split(A(x), ","))) + 1 Then
A(x) = A(x) & "," & v(i, j)
Else
' ' 連番で無い時のは何でもグループにいれてしまう？
' A(x) = A(x) & "," & v(i, j)
End If
Next
End If
Next
v = Range("G2:N" & eRow).Value
For i = 1 To UBound(v)
For j = 1 To UBound(A)
D = Split(A(j), ",")
For x = 0 To UBound(D)
If CStr(v(i, 1)) = D(x) Then
v(i, 8) = A(j)
Exit For
End If
Next
Next
Next
Range("G2").Resize(UBound(v), UBound(v, 2)).Value = v
End Sub
|
|
Yuki
- 08/12/1(月) 13:42 -
