Private Sub CommandButton3_Click() Dim arr, arr1, i&, d As Object arr = Sheets(3).[a1].CurrentRegion arr1 = [a1].CurrentRegion Set d = CreateObject("scripting.dictionary") For i = 2 To UBound(arr1) If d.exists(arr1(i, 1)) Then d(arr1(i, 1)) = Array("", arr1(i, 3), "", arr1(i, 5), arr1(i, 6)) Sheets(3).[b2].Resize(d.Count, UBound(arr, 2) - 1) = Application.Transpose(Application.Transpose(d.items)) Private Sub CommandButton1_Click() Set d = CreateObject("scripting.dictionary") brr = Sheet3.Range("a1").CurrentRegion Sheet3.Range("a1").CurrentRegion = brr brr(i, c(j)) = arr(n, c(j)) http://club./thread-1057654-1-1.html http://club./thread-698873-1-1.html
|