Excel - makro valitud ridade ühendamiseks
Probleem
Mul on Excelis lähteandmeid, nagu see on:
CustomerID SalesMonth SalesAmount
12345 jaanuar 150 12345 märts 100 12345 apr 200 56789 jaanuar 800 56789 10. mai 78945 november 20 44444 jaanuar 1000 ....
CustomerID ja SalesMonth kombinatsioon on ainulaadne.
Ja tahaksin kombineerida lähteandmeid teises Exceli vahekaardis sellisel kujul:
CustomerID 1stMonth 1stAmount 2ndMonth 2ndAmount 3rdMonth 3rd Summa
12345 jaanuar 150 märts 100 apr 200 56789 jaanuar 800 mai 10 78945 november 20 44444 jaanuar 1000
Kokku võib klient olla kuni 10 erinevat kuud (mõnedel on ainult 1 või 2). Tähtis on see, et üheski väljundreas ei ole „lünki”, nt kui kliendil on müük ainult novembris, siis peaks „1stMonth” rakk lugema selle kliendi jaoks „Nov”.
Lahendus
Proovige seda makro ja vaadake lehte 2 (kopeerige andmed ohutuskaardina lehele 1 lehele 3)
Alamtest () Mõõdetakse klienti kui vahemikku, ddata () kui vahemikku, custunq kui vahemikku, cunq kui vahemik, filt kui vahemik Dim dest As vahemik, j nii kaua, k nii kaua tölehtedega ("sheet1") seadke klient = vahemik ( .Range ("A1"), .Range ("A1"). Lõpp (xlDown)) Set custunq = .Range ("A1"). Lõpp (xlDown) .Kasutaja (5, 0) klient.KasutatudFilter xlFilterCopy,, custunq, True Set custunq = Range (custunq.Offset (1, 0), custunq.End (xlDown)) Iga custunq jaoks custunq .Range ("A1"). CurrentRegion.AutoFilter väli: = 1, kriteeriumid1: = custunq.Value Set filt = .Range ("A1"). CurrentRegion.Offset (1, 0) .Resize (Rows.Count - 1, Columns.Count). _ SpecialCells (xlCellTypeVisible) j = WorksheetFunction.CountA (filt.Columns (1)) 'MsgBox j ReDim ddata (1 to j) Töölehtedega ("sheet2") Määrake dest = .Cells (read.Count, "A"). Lõpp (xlUp) .Offset (1, 0) dest = filt (1, 1) Lõpeta k = 1 kuni j Seadista ddata (k) = .Range (filt (k, 2), filt (k, 3)) ddata (k) .Kopeeri töölehtedega ("sheet2") .Kellad (dest.Row, Columns.Count) .End (xlToLeft) .Offset (0, 1) .PastaSpetsiaalne lõpp koos järgmise k .Range ("A1"). CurrentRegion.AutoFilter Next custunq Range (.Range ("a1"). End (xlDown) .Offset (1, 0), .Cells (read.Count, "A"). End (xlUp). EntireRow.Delete lõpetamine Lõpeta sub Subdo undo () töölehed ("sheet2") Tänu Venkat1926-le selle näpunäite eest.