|
▼ののか さん:
おじゃまします。
すべて配列にコピーして 配列内で統合してみたらどうですか?
6列目をキーにしています。
Sub 統合プログラム()
Dim BOOKNAME '元ファイル名
Dim WS1 As Worksheet '対象シート
Dim Target As Range '処理対象範囲
Dim i As Long, j As Long, n As Long, m As Long
Dim v As Variant
Dim key
'ファイルを開く
BOOKNAME = Application.GetOpenFilename(MultiSelect:=False)
If VarType(BOOKNAME) = vbBoolean Then Exit Sub
With Workbooks.Open(Filename:=BOOKNAME)
BOOKNAME = .Name
Set WS1 = .Worksheets(Left$(BOOKNAME, Len(BOOKNAME) - 4)) '対象シート
End With
Set Target = WS1.Range("A1").CurrentRegion
v = Target.Value
m = UBound(v, 2)
n = 1
For i = 2 To UBound(v)
If key <> v(i, 6) Then
key = v(i, 6)
n = n + 1
If n <> i Then
For j = 1 To m
v(n, j) = v(i, j)
Next
End If
Else
For j = 15 To 20
v(n, j) = v(n, j) + v(i, j)
Next
End If
Next
Target.ClearContents
Target.Resize(n).Value = v
End Sub
|
|