Option Explicit
Sub test()
Dim dic As Object
Dim ws As Worksheet
Dim v, w()
Dim j As Long, k As Long
Dim s As String
Dim m As Long, n As Long
Set dic = CreateObject("scripting.dictionary")
ReDim w(1 To Rows.Count, 1 To 100)
For Each ws In Worksheets
v = ws.Cells(1).CurrentRegion.Value
For j = 1 To UBound(v, 1)
s = v(j, 1) & v(j, 2) & v(j, 3) & v(j, 4)
If Not dic.exists(s) Then
n = dic.Count + 1
dic(s) = n
w(n, 1) = v(j, 1)
w(n, 2) = v(j, 2)
w(n, 3) = v(j, 3)
w(n, 4) = v(j, 4)
End If
n = dic(s)
For k = 5 To UBound(v, 2)
w(n, k + m) = v(j, k)
Next
Next
m = m + UBound(v, 2) - 4
Next
With Workbooks.Add(xlWBATWorksheet).Sheets(1).Cells(1)
.Resize(dic.Count, m - 1).Value = w
.CurrentRegion.Sort .Columns(3), Header:=xlYes
End With
End Sub
マナ