| |
▼やみ さん： こんにちは〜
>A列とB列をKEYにしてC列〜J列の値をまとめて、重複してる文字を消したい
すみません。ろくすっぽ、書かれたコード読んでませんが m(_ _)m
こういう key別(A列＋B列の項目別)にC列〜J列のデータをまとめる処理には
Dictionaryオブジェクトを利用するのが手っ取り早いと思います。
↓でやってることは、
dicというDictionaryオブジェクトに各行の(A列＋B列の)keyを格納していって
・keyがはじめて出現したものだったら（if not dic.Exists(ss) then）
出力用配列の k行目にデータをコピーし、
・すでに出現済みのkeyであれば、すでに出力してある行に、C列からJ列までの
データを結合（または合計）していき、
最後に Sheet2 にまとめた結果を出力する、
というものです。
Sub Try1()
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
Dim vi, i As Long, j As Long
Dim k As Long, n As Long
Dim ss As String
'元データはSheet1 と仮定
With Worksheets(1)
vi = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 10).Value
End With
ReDim vo(1 To UBound(vi), 1 To 10)
For i = 1 To UBound(vi)
ss = vi(i, 1) & vbTab & vi(i, 2)
If Not dic.Exists(ss) Then
k = k + 1
dic(ss) = k
For j = 1 To 10 '値のうめこみ(すべての列)
vo(k, j) = vi(i, j)
Next
Else
n = dic(ss)
For j = 3 To 9 '文字列の結合
If InStr(vo(n, j), vi(i, j)) = 0 Then
vo(n, j) = vo(n, j) & "・" & vi(i, j)
End If
Next
vo(n, 10) = vo(n, 10) + vi(i, 10)
End If
Next
Set dic = Nothing
'Sheet2 に貼り付け （テストのため、別シートに結果を出力）
With Worksheets(2)
.UsedRange.ClearContents
.Cells(1).Resize(, 10) = Worksheets(1).Cells(1).Resize(, 10).Value
.Cells(2, 1).Resize(k, 10) = vo
End With
End Sub
※なお、簡単のため、文字列がすでに書き込まれているかのチェックを
非常に簡単な方法でチェックしています。
If InStr(vo(n, j), vi(i, j)) = 0 Then
たとえば
出力用配列のある位置vo(n,j)に 「みかん・いも」とすでに書き込んであって
いま vi(i,j) が「スイカ」だったとします。
「みかん・いも」のなかには「スイカ」という文字列は見つかりませんから、
"スイカ" はこれまでの文字列と結合されて 「みかん・いも・すいか」とな
ります。
ところが、チェックする文字列が仮に「かん」だったとしますと、
InStr(vo(n, j), vi(i, j))
は 2 を返しますから（「みかん・いも」の2文字目にマッチする）結果「かん」
は追加されない、という不具合が発生します。
上のコードは、こういう特殊ケースがありえないと仮定したコードです。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
