|
Sub Multi()rmax = [A65535].End(xlUp).RowFor i = 2 To rmax Range('D' & i) = Range('A' & i) & Range('B' & i)NextRange('A:D').Sort Key1:=[A1], Key2:=[B1], Key3:=[C1]Set cc = Range('D2')Do While Not IsEmpty(cc) Set nn = cc.Offset(1, 0) If nn.Value = cc.Value Then r = cc.Row() If Range('C' & r) <> Range('C' & r + 1) Then Range('C' & r + 1).Value = Range('C' & r) & '/' & Range('C' & r + 1) End If cc.EntireRow.Delete End If Set cc = nnLoopRange('D:D') = Nullrmax = [A65535].End(xlUp).RowFor i = 2 To rmax Range('D' & i).FormulaR1C1 = '=RC1&COUNTIF(R1C1:RC1,RC1)'NextSet d = CreateObject('scripting.dictionary')Dim allA As VariantallA = Range('A2:A' & rmax)If IsArray(allA) Then For i = 1 To UBound(allA) eachA = allA(i, 1) If Not d.exists(eachA) And eachA <> '' Then d.Add eachA, eachA End If NextElse eachA = allA d.Add eachA, eachAEnd If If UBound(d.keys) <> -1 Then [G2].Resize(UBound(d.keys) + 1, 1) = Application.Transpose(d.keys)End Ifd.RemoveAllrmax = [G65535].End(xlUp).RowRange('H2:M' & rmax).FormulaR1C1 = '=IFERROR(VLOOKUP(RC7&COLUMN()-COLUMN(RC7),' & _ 'IF({1,0},R2C4:R100C4,R2C2:R100C2),2,0),'''')'Range('H2:M' & rmax).Value = Range('H2:M' & rmax).ValueRange('D:D') = NullApplication.ReferenceStyle = xlA1End Sub |
|
|
