VBA sorbarendezés - kivétellel
2021-11-30T11:53:34+01:00
2021-12-01T01:15:14+01:00
2022-08-12T05:55:30+02:00
Svenson
Sziasztok!

Egy olyan problémám van, hogy Excel táblázat adatait szeretném sorbarendezni úgy, hogy 
A oszlop szerint növekvő, 
C oszlop szerint növekvő,
B oszlop sorszámoz A oszlop kategóriáján belül (azonos A értékek), de a C oszlop Y-00106013 értéke  mindig az utolsó sorszámot kapja az A-ban jelölt kategórián belül.

Minta táblázatot mellékeltem, sárgával kiemelve a külön kezelt érték.
Fontos, hogy a többi oszlop adatai is együtt mozogjanak (soronként). 

Elég kezdő vagyok, most ismerekedem a kódokkal, mert ilyen problémák megoldásának gyorsítása sokat segítene a melóban..

Nagyon köszönöm előre is a segítséget!
Mutasd a teljes hozzászólást!
Csatolt állomány
Szia!
Észrevételek:
1.

'C oszlop, utolsó nem üres sorig
'ezzel gondja van ("424"), próbálkoztam máshogy megírni - eredménytelenül
Set Tartomany = Worksheets("Munka1").Cells(Rows.Count, "C").End(xlDown).Row

a.) A Tartomany változód Range - azaz objektum. Helyes, hogy Set-tel szeretnél értéket adni neki. Viszont a jobb oldalon álló kifejezés eredménye (Row) egy szám lesz, ez nem tartomány.
b.)
Cells(Rows.Count, "C").End(xlDown)
=> a C oszlop utolsó cellájától szeretnél lefelé menni, ez nem a szükséges eredmény. Helyette End(xlUp) a megfelelő. 
A Row, mint az előbb írtam, nem szükséges. Viszont a
Cells(Rows.Count, "C").End(xlUp)
eredménye a C oszlop utolsó használt cellája lesz, nem pedig a teljes C oszlop. A teljes C oszlopot a
Range("C1",Cells(Rows.Count, "C").End(xlUp))
eredményezi. Vagyis helyesen:

Set Tartomany=Range("C1",Cells(Rows.Count, "C").End(xlUp))
De van ennél egy még egyszerűbb megoldás:

Set Tartomany=Range("A1").Currentregion.Columns("C").
A többi Range típusú változódra hasonló javítások szükségesek.
2. Nagyon jó ötlet az érték cseréje a rendezéshez.
3. A sorszám adásnál is van egy pici hiba, a javított így néz ki:

For y = 2 To ItemCsoportok.Rows.Count If Not ItemCsoportok.Cells(y).Value = ItemCsoportok.Cells(y - 1).Value Then Sorszam.Cells(y).Value = "1" Else Sorszam.Cells(y).Value = Sorszam.Cells(y - 1).Value + 1 End If Next y
a)A ciklusváltozó felső határa nem lehet tartomány, hanem a tartomány sorainak száma.
b)Az Else ágon az előző cella értékét kell növelni és nem a ciklusváltozó értékét.
A változtatásokat bold-dal jelöltem.
Üdv.
Mutasd a teljes hozzászólást!

  • Hali!

    Mutasd – VBA-forráskóddal/-részlettel –, hogy eddig mivel, hogyan próbálkoztál, meddig jutottál el, mi nem megy, miben/hol akadtál el!

    Mutasd a teljes hozzászólást!
  • Szia!

    Ha csak 1 azonos kivétel van minden cikknél,VBA nélkül is megoldható. Egy segédoszlopot kell használnod a sorszámozáshoz. Nálam ez az N oszlop volt.
    N2 cella értéke 1
    N3 cella képlete:
    =HA(A3<>A2;1;HA(C3="Y-00106013";DARABTELI(A:A;A3);HA(DARABTELI(A:A;A3)=N2+1;N1+1;N2+1)))
    Ez húzható lefelé az N oszlopon.
    Ezután N oszlop másolás  - B2 cella kijelölés - irányított beillesztés értéket. Az N oszlop törölhető.
    Rendezés ---> 1. szint A oszlop, 2. szint B oszlop!!! 3. szint C oszlop
    Ha nem a sorszám a második szint, akkor hiába sorszámoztuk át a listát.
    Üdv.
    Mutasd a teljes hozzászólást!
  • Szia, 

    Igaz! 
    A lentebb olvasható kódig jutottam.
    Kérlek, nézzétek el nekem, biztos sok hiba van benne és biztosan vannak jobb megoldások.
    A nevezetes érték sor végére helyezésére is biztosan van elegánsabb megoldás...

    Köszi!

    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 'A mentés gombra kattintva lefut, majd mentésre kerül, és egy mentés másként is lefut a megadott névvel. Dim Tartomany As Range Dim ItemCsoportok As Range Dim y As Integer Dim Sorszam As Range Dim UjNev As Variant 'C oszlop, utolsó nem üres sorig 'ezzel gondja van ("424"), próbálkoztam máshogy megírni - eredménytelenül Set Tartomany = Worksheets("Munka1").Cells(Rows.Count, "C").End(xlDown).Row 'A oszlop, utolsó nem üres sorig Set ItemCsoportok = Worksheets("Munka1").Cells(Rows.Count, "A").End(xlDown).Row 'B oszlop, utolsó nem üres sorig Set Sorszam = Worksheets("Munka1").Cells(Rows.Count, "B").End(xlDown).Row 'Kicserélem a kivételezett értéket, homogénan kezelhetőre Range("Tartomany").Replace What:="Y-00106013", Replacement:="ZZZY-00106013", MatchCase:=True 'Sorbarendezek Item/Charge_Item sorrendben Sheets("Munka1").Range("a1").CurrentRegion.Sort _ key1:=Range("a1"), key2:=Range("c1"), order1:=xlAscending, Header:=xlYes 'Visszamódosítom a kicserélt értéket az eredetire, így már jó helyen van a jó érték Range("Tartomany").Replace What:="ZZZY-00106013", Replacement:="Y-00106013", MatchCase:=True 'Sorszámot adok az egyes sorokhoz. Item-enként újraindul a számozás. (Eltérő Item-nél "1" értéket vesz fel.) For y = 2 To ItemCsoportok If Not ItemCsoportok.Cells(y).Value = ItemCsoportok.Cells(y - 1).Value Then Sorszam.Cells(y).Value = "1" Else Sorszam.Cells(y).Value = y + 1 End If Next y 'Az eredményt kiíratom egy .xlsx fájlba, mentés másként-el UjNev = Application.GetSaveAsFilename If UjNev <> False Then ActiveWorkbook.SaveAs Filename:="nem_neveztel_el.xlsx" End If End Sub
    Mutasd a teljes hozzászólást!
  • Szia!

    Köszönöm, de sajnos ez a megoldás nálam nem járt helyes eredménnyel.
    Mutasd a teljes hozzászólást!
  • Szia!
    Észrevételek:
    1.

    'C oszlop, utolsó nem üres sorig
    'ezzel gondja van ("424"), próbálkoztam máshogy megírni - eredménytelenül
    Set Tartomany = Worksheets("Munka1").Cells(Rows.Count, "C").End(xlDown).Row

    a.) A Tartomany változód Range - azaz objektum. Helyes, hogy Set-tel szeretnél értéket adni neki. Viszont a jobb oldalon álló kifejezés eredménye (Row) egy szám lesz, ez nem tartomány.
    b.)
    Cells(Rows.Count, "C").End(xlDown)
    => a C oszlop utolsó cellájától szeretnél lefelé menni, ez nem a szükséges eredmény. Helyette End(xlUp) a megfelelő. 
    A Row, mint az előbb írtam, nem szükséges. Viszont a
    Cells(Rows.Count, "C").End(xlUp)
    eredménye a C oszlop utolsó használt cellája lesz, nem pedig a teljes C oszlop. A teljes C oszlopot a
    Range("C1",Cells(Rows.Count, "C").End(xlUp))
    eredményezi. Vagyis helyesen:

    Set Tartomany=Range("C1",Cells(Rows.Count, "C").End(xlUp))
    De van ennél egy még egyszerűbb megoldás:

    Set Tartomany=Range("A1").Currentregion.Columns("C").
    A többi Range típusú változódra hasonló javítások szükségesek.
    2. Nagyon jó ötlet az érték cseréje a rendezéshez.
    3. A sorszám adásnál is van egy pici hiba, a javított így néz ki:

    For y = 2 To ItemCsoportok.Rows.Count If Not ItemCsoportok.Cells(y).Value = ItemCsoportok.Cells(y - 1).Value Then Sorszam.Cells(y).Value = "1" Else Sorszam.Cells(y).Value = Sorszam.Cells(y - 1).Value + 1 End If Next y
    a)A ciklusváltozó felső határa nem lehet tartomány, hanem a tartomány sorainak száma.
    b)Az Else ágon az előző cella értékét kell növelni és nem a ciklusváltozó értékét.
    A változtatásokat bold-dal jelöltem.
    Üdv.
    Mutasd a teljes hozzászólást!
  • Szia!

    Köszönöm a javításokat, észrevételeket, magyarázatokat és a gyorsaságot!

    Az észrevételek fényében javítottam a kódokat.
    Egy kicsit módosítottam is a végén pár dolgon, így már szépen működik.
    Mutasd a teljes hozzászólást!
Tetszett amit olvastál? Szeretnél a jövőben is értesülni a hasonló érdekességekről?
abcd