Sortierung einer Spalte innerhalb einer Tabelle ohne andere Spalten mit zu sortieren

  • Excel

Es gibt 76 Antworten in diesem Thema. Der letzte Beitrag () ist von cry.baby.

    Update: Aktualisierter Code siehe unten!

    Kopier am besten das ganze Modul nochmal neu rein. Habe es getestet und es sollte funktionieren:

    Visual Basic-Quellcode

    1. Option Explicit
    3. Sub Einfaerben()
    5. Const Blau = 15773696 'RGB(0, 176, 240)
    6. Const Lila = 10498160 'RGB(121, 48, 160)
    7. Const Gelb = 65535 'RGB(255, 255, 0)
    8. Const Grün = 5287936 'RGB(0,176,80)
    9. Const Rot = 255 'RGB(255,0,0)
    10. Const Orange = 52479 'RGB(255,204,0)
    12. Dim AnzahlGV0598_blau, AnzahlGV0587_lila, AnzahlGV0588_gelb, AnzahlGV0598_grün, AnzahlGV0587_rot, AnzahlGV0588_orange As Integer
    13. Dim GezähltGV0598, GezähltGV0587, GezähltGV0588 As Integer
    14. Dim Finden, RangeFinden, r As Range
    17. 'Hilfsspalte D mit Farbnummern erstellen
    18. With Sheets("Tabelle2")
    20. For Each r In Intersect(.UsedRange, .Range("B:B"))
    21. r.Offset(0, 2) = r.Interior.Color
    22. Next r
    24. 'Anschließend die Stückzahl zur jeweiligen GV dynamisch ermitteln
    25. Set RangeFinden = .Range("D2", .Range("D2").End(xlDown))
    27. AnzahlGV0598_blau = AnzahlFarben(RangeFinden, Blau)
    28. AnzahlGV0587_lila = AnzahlFarben(RangeFinden, Lila)
    29. AnzahlGV0588_gelb = AnzahlFarben(RangeFinden, Gelb)
    30. AnzahlGV0598_grün = AnzahlFarben(RangeFinden, Grün)
    31. AnzahlGV0587_rot = AnzahlFarben(RangeFinden, Rot)
    32. AnzahlGV0588_orange = AnzahlFarben(RangeFinden, Orange)
    34. End With
    36. With Sheets("Tabelle1")
    38. 'Für GV0598_blau
    39. GezähltGV0598 = 0
    40. For Each r In Intersect(.UsedRange, .Range("B:B"))
    41. If r = "GV0598" And GezähltGV0598 < AnzahlGV0598_blau Then
    42. GezähltGV0598 = GezähltGV0598 + r.Count
    43. r.Offset(0, -1).Interior.Color = Blau
    44. End If
    45. Next r
    46. 'Für GV0587_lila
    47. GezähltGV0587 = 0
    48. For Each r In Intersect(.UsedRange, .Range("B:B"))
    49. If r = "GV0587" And GezähltGV0587 < AnzahlGV0587_lila Then
    50. GezähltGV0587 = GezähltGV0587 + r.Count
    51. r.Offset(0, -1).Interior.Color = Lila
    52. End If
    53. Next r
    54. 'Für GV0588_gelb
    55. GezähltGV0588 = 0
    56. For Each r In Intersect(.UsedRange, .Range("B:B"))
    57. If r = "GV0588" And GezähltGV0588 < AnzahlGV0588_gelb Then
    58. GezähltGV0588 = GezähltGV0588 + r.Count
    59. r.Offset(0, -1).Interior.Color = Gelb
    60. End If
    61. Next r
    63. 'Für GV0598_grün
    64. GezähltGV0598 = 0
    65. For Each r In Intersect(.UsedRange, .Range("B:B"))
    66. If r = "GV0598" Then
    67. GezähltGV0598 = GezähltGV0598 + r.Count
    69. If r = "GV0598" And GezähltGV0598 > AnzahlGV0598_blau And GezähltGV0598 <= AnzahlGV0598_blau + AnzahlGV0598_grün Then
    70. r.Offset(0, -1).Interior.Color = Grün
    71. End If
    73. End If
    74. Next r
    76. 'Für GV0587_rot
    77. GezähltGV0587 = 0
    78. For Each r In Intersect(.UsedRange, .Range("B:B"))
    79. If r = "GV0587" Then
    80. GezähltGV0587 = GezähltGV0587 + r.Count
    82. If r = "GV0587" And GezähltGV0587 > AnzahlGV0587_lila And GezähltGV0587 <= AnzahlGV0587_lila + AnzahlGV0587_rot Then
    83. r.Offset(0, -1).Interior.Color = Rot
    84. End If
    86. End If
    87. Next r
    89. 'Für GV0588_orange
    90. GezähltGV0588 = 0
    91. For Each r In Intersect(.UsedRange, .Range("B:B"))
    92. If r = "GV0588" Then
    93. GezähltGV0588 = GezähltGV0588 + r.Count
    95. If r = "GV0588" And GezähltGV0588 > AnzahlGV0588_gelb And GezähltGV0588 <= AnzahlGV0588_gelb + AnzahlGV0588_orange Then
    96. r.Offset(0, -1).Interior.Color = Orange
    97. End If
    99. End If
    100. Next r
    102. End With
    104. End Sub
    106. Function AnzahlFarben(ByVal SuchRange As Range, Farbenname As String) As Integer
    108. Dim Rng As Range
    110. Set Rng = SuchRange.Find(Farbenname)
    112. If Not Rng Is Nothing Then AnzahlFarben = Val(Rng.Offset(0, -2).Value)
    114. End Function

    Dieser Beitrag wurde bereits 5 mal editiert, zuletzt von „cry.baby“ ()

    Wo weist er den Fehler genau aus? Hier?

    Visual Basic-Quellcode

    1. ​
    2. 'Hilfsspalte D mit Farbnummern erstellen
    3. With Sheets("Tabelle2")
    5. For Each r In Intersect(.UsedRange, .Range("B:B"))
    6. r.Offset(0, 2) = r.Interior.Color
    7. Next r
    9. End With


    Dann probier es mal so:

    Visual Basic-Quellcode

    1. ​
    2. 'Hilfsspalte D mit Farbnummern erstellen
    3. Sheets("Tabelle2").activate
    5. For Each r In Intersect(Tabelle2.UsedRange, Tabelle2.Range("B:B"))
    6. r.Offset(0, 2) = r.Interior.Color
    7. Next r

    Leider immer noch nicht.
    Habe mal meinen Code rein kopiert.
    Die rot markierte Zeile ist die wo er den fehler ausgibt.
    Die grünen sind die alternativen Zeilen als Textzeile markiert.
    Habe immer beides mal ausprobiert. Aber immer der selbe Fehler in der gleichen Zeile.

    Visual Basic-Quellcode

    1. Option Explicit
    3. Private Sub CommandButton1_Click()
    5. Const Blau = 15773696 'RGB(0, 176, 240)
    6. Const Lila = 10498160 'RGB(121, 48, 160)
    7. Const Gelb = 65535 'RGB(255, 255, 0)
    8. Const Grün = 5287936 'RGB(0,176,80)
    9. Const Rot = 255 'RGB(255,0,0)
    10. Const Orange = 52479 'RGB(255,204,0)
    12. Dim AnzahlGV0598_blau, AnzahlGV0587_lila, AnzahlGV0588_gelb, AnzahlGV0598_grün, AnzahlGV0587_rot, AnzahlGV0588_orange As Integer
    13. Dim GezähltGV0598, GezähltGV0587, GezähltGV0588 As Integer
    14. Dim RangeStckZahl As Range
    15. Dim r As Range
    16. Dim Finden As Variant
    17. Dim RangeFinden As Range
    19. 'Hilfsspalte D mit Farbnummern erstellen
    21. 'With Sheets("Tabelle2")
    22. Sheets("Tabelle2").Activate
    24. 'For Each r In Intersect(.UsedRange, .Range("B:B"))
    25. For Each r In Intersect(Tabelle2.UsedRange, Tabelle2.Range("B:B"))
    26. r.Offset(0, 2) = r.Interior.Color
    27. Next r
    29. 'End With
    31. 'Anschließend die Stückzahl zur jeweiligen GV dynamisch ermitteln
    33. Sheets("Tabelle2").Activate
    35. Set RangeFinden = Range("D2", Range("D2").End(xlDown))
    36. Finden = RangeFinden.Find(Blau).Offset(0, -2) ' <<--- FEHLER HIER
    37. AnzahlGV0598_blau = Finden
    39. Finden = RangeFinden.Find(Lila).Offset(0, -2)
    40. AnzahlGV0587_lila = Finden
    42. Finden = RangeFinden.Find(Gelb).Offset(0, -2)
    43. AnzahlGV0588_gelb = Finden
    45. Finden = RangeFinden.Find(Grün).Offset(0, -2)
    46. AnzahlGV0598_grün = Finden
    48. Finden = RangeFinden.Find(Rot).Offset(0, -2)
    49. AnzahlGV0587_rot = Finden
    51. Finden = RangeFinden.Find(Orange).Offset(0, -2)
    52. AnzahlGV0588_orange = Finden
    55. 'With Sheets("Tabelle1")
    56. Sheets("Tabelle1").Activate
    58. 'Für GV0598_blau
    59. GezähltGV0598 = 0
    60. 'For Each r In Intersect(.UsedRange, .Range("B:B"))
    61. For Each r In Intersect(Tabelle1.UsedRange, Tabelle1.Range("B:B"))
    63. If r = "GV0598" And GezähltGV0598 < AnzahlGV0598_blau Then
    64. GezähltGV0598 = GezähltGV0598 + r.Count
    65. r.Offset(0, -1).Interior.Color = Blau
    66. End If
    68. Next r
    70. 'Für GV0587_lila
    71. GezähltGV0587 = 0
    72. For Each r In Intersect(Tabelle1.UsedRange, Tabelle1.Range("B:B"))
    74. If r = "GV0587" And GezähltGV0587 < AnzahlGV0587_lila Then
    75. GezähltGV0587 = GezähltGV0587 + r.Count
    76. r.Offset(0, -1).Interior.Color = Lila
    77. End If
    79. Next r
    81. 'Für GV0588_gelb
    82. GezähltGV0588 = 0
    83. For Each r In Intersect(Tabelle1.UsedRange, Tabelle1.Range("B:B"))
    85. If r = "GV0588" And GezähltGV0588 < AnzahlGV0588_gelb Then
    86. GezähltGV0588 = GezähltGV0588 + r.Count
    87. r.Offset(0, -1).Interior.Color = Gelb
    88. End If
    90. Next r
    92. 'Für GV0598_grün
    93. GezähltGV0598 = 0
    94. For Each r In Intersect(Tabelle1.UsedRange, Tabelle1.Range("B:B"))
    96. If r = "GV0598" Then
    97. GezähltGV0598 = GezähltGV0598 + r.Count
    99. If r = "GV0598" And GezähltGV0598 > AnzahlGV0598_blau And GezähltGV0598 <= AnzahlGV0598_blau + AnzahlGV0598_grün Then
    100. r.Offset(0, -1).Interior.Color = Grün
    101. End If
    103. End If
    104. Next r
    106. 'Für GV0587_rot
    107. GezähltGV0587 = 0
    108. For Each r In Intersect(Tabelle1.UsedRange, Tabelle1.Range("B:B"))
    110. If r = "GV0587" Then
    111. GezähltGV0587 = GezähltGV0587 + r.Count
    113. If r = "GV0587" And GezähltGV0587 > AnzahlGV0587_lila And GezähltGV0587 <= AnzahlGV0587_lila + AnzahlGV0587_rot Then
    114. r.Offset(0, -1).Interior.Color = Rot
    115. End If
    117. End If
    118. Next r
    120. 'Für GV0588_orange
    121. GezähltGV0588 = 0
    122. For Each r In Intersect(Tabelle1.UsedRange, Tabelle1.Range("B:B"))
    124. If r = "GV0588" Then
    125. GezähltGV0588 = GezähltGV0588 + r.Count
    127. If r = "GV0588" And GezähltGV0588 > AnzahlGV0588_gelb And GezähltGV0588 <= AnzahlGV0588_gelb + AnzahlGV0588_orange Then
    128. r.Offset(0, -1).Interior.Color = Orange
    129. End If
    131. End If
    132. Next r
    134. 'End With
    136. End Sub


    Code-Tags eingefügt. ~Thunderbolt

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „Thunderbolt“ ()

    Parawolli schrieb:

    Finden = RangeFinden.Find(Blau).Offset(0, -2)

    Range.Find gibt ein Range-Objekt zurück und muss deshalb entsprechend zugewiesen werden:

    Visual Basic-Quellcode

    1. Set Finden = RangeFinden.Find(Blau) 'wenn nichts gefunden wird, wird hier ein Null-Objekt zurückgegeben (Nothing)
    2. If Not Finden Is Nothing Then FindenBlau = Finden.Offset(0, -2).Value

    Es ist schade, dass VBA kein Option Strict On kennt.
    Du kannst es dir trotzdem weitgehend erleichtern, wenn du nie Variant verwendest, sondern die Variablen mit dem richtigen Datentyp deklarierst.
    Dim RangeFinden As Range

    Die Tatsache, dass der Code bei erfolgreicher Suche läuft, liegt an der Tatsache, dass bei der Zuweisung
    Finden = RangeFinden.Find(Blau).Offset(0, -2)
    Nicht das Range-Objekt RangeFinden.Find(Blau).Offset(0, -2), sondern dessen Default-Property Value zugewisen wird.
    Also streng genommen: Finden = RangeFinden.Find(Blau).Offset(0, -2).Value
    Wenn aber halt RangeFinden.Find(Blau) Nothing ist, crasht das Ganze, weil Nothing nun mal keine Property Offset hat.
    Deswegen bei Range.Find immer überprüfen, ob was gefunden wurde.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    Dieser Beitrag wurde bereits 4 mal editiert, zuletzt von „petaod“ ()

    Hallo petaod,
    Ich habe mal Deinen Code (Siehe unten) eingegeben.
    Die beiden roten Zeilen werden abwechselnd als Fehler ausgegeben.
    Wahrscheinlich habe ich aber auch nicht ganz verstanden was ich jetzt machen musste und habe es falsch eingegeben.
    Beim ersten mal hat er das FindenBlau als Fehler ausgegeben, weil es wahrscheinlich nicht deklariert war. Nachden ich es als Variable bzw. Range angelegt hatte, hat er mir die Zeile dadrüber als Fehler angegeben.

    'Dim FindenBlau As Variant
    Dim FindenBlau As Range

    Sheets("Tabelle2").Activate

    Set Finden = RangeFinden.Find(Blau) 'wenn nichts gefunden wird, wird hier ein Null-Objekt zurückgegeben (Nothing)
    If Not Finden Is Nothing Then FindenBlau = Finden.Offset(0, -2).Value

    Set RangeFinden = Range("D2", Range("D2").End(xlDown))

    Finden = RangeFinden.Find(Blau).Offset(0, -2).Value
    AnzahlGV0598_blau = Finden

    *Rot in blau geändert, siehe Regeln bzgl. Moderatorenfarbe*

    Dieser Beitrag wurde bereits 3 mal editiert, zuletzt von „Marcus Gräfe“ ()

    Du musst sowohl 'Finden' als auch 'RangeFinden' als Range deklarieren. Da 'Finden' jetzt kein Variant mehr ist, sondern eine Range und somit eine Objekt_Variable, musst Du Finden ein 'Set' vorsetzen. Zudem muss 'RangeFinden' vor der Methode .Find bestimmt werden. In Code sieht das dann so aus:

    Visual Basic-Quellcode

    1. Dim Finden, RangeFinden As Range
    3. 'Anschließend die Stückzahl zur jeweiligen GV dynamisch ermitteln
    4. Sheets("Tabelle2").Activate
    6. Set RangeFinden = Range("D2", Range("D2").End(xlDown))
    8. Set Finden = RangeFinden.Find(Blau).Offset(0, -2)
    10. If Not Finden Is Nothing Then
    11. AnzahlGV0598_blau = Finden
    12. End If


    @Petaod: Danke für die Lehreinheit! Hab wieder was dazugelernt!

    cry.baby schrieb:

    Set Finden = RangeFinden.Find(Blau).Offset(0, -2)
    Führt auch zu einem Crash, wenn Blau nicht gefunden wird.
    Dann ist RangeFinden.Find(Blau)=Nothing.
    Und Nothing.Offset(0, -2) gibt es nicht.
    Deshalb erst suchen und, nur wenn gefunden, die nachfolgenden Schritte durchführen.

    Deshalb

    Visual Basic-Quellcode

    1. Set Finden = RangeFinden.Find(Blau)
    2. If Not Finden Is Nothing Then AnzahlGV0598_blau = Finden.Offset(0, -2).Value
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    X/ Dann würde ich ein 'On Error Resume Next' und 'On Error Goto 0' einbauen. Müsste in dem Fall ausreichen, oder? Bzw. gleich richtig:

    Visual Basic-Quellcode

    1. Set Finden = RangeFinden.Find(Blau) '.Offset(0, -2)
    2. If Not Finden Is Nothing Then
    3. AnzahlGV0598_blau = Finden.Offset(0, 2).value
    4. End If


    Vollzitat entfernt. ~Thunderbolt


    Dieser Beitrag wurde bereits 4 mal editiert, zuletzt von „Thunderbolt“ ()

    cry.baby schrieb:

    Dann würde ich ein 'On Error Resume Next' und 'On Error Goto 0' einbauen
    Erwartete Fehler mit On Error abzufangen ist kein besonders guter Stil.
    Im übrigen würde ich so etwas nur in einer überschaubaren Funktion durchführen.
    On Error Goto 0 hebt alle EventHandler auf, die sich ggf. noch in der Routine befinden.

    Wenn dann so:

    Visual Basic-Quellcode

    1. Function NumberOfColors(ByVal SearchRange As Range, Colorname As String) As Integer
    2. On Error Goto Done
    3. NumberOfColors = SearchRange.Find(ColorName).Offset(0, -2)
    4. Done:
    5. End Function


    Und im Code dann einfach für jede Farbe entsprechend.

    Visual Basic-Quellcode

    1. GV0598_blau = NumberOfColors(RangeFinden, Blau)


    Ich würde dennoch für die Funktion die saubere Variante wählen

    Visual Basic-Quellcode

    1. Function NumberOfColors(ByVal SearchRange As Range, Colorname As String) As Long
    2. Dim Rng As Range
    3. Set Rng = SearchRange.Find(ColorName)
    4. If Not Rng Is Nothing Then NumberOfColors = Val(Rng.Offset(0, -2).Value)
    5. End Function

    Ist nicht länger, aber erfordert keine unnötige zeitintensive Fehlerbehandlung.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    Hi Wolfgang,

    ich habe den Code weiter oben (zweites Posting) entsprechend den Hinweisen von petaod aktualisiert. Du kannst ihn kopieren/einfügen, dann sollte es jetzt gehen.

    Die Funktion von petaod habe ich auch nocheingebaut (nur mit deutschen Namen um der Linie treu zu bleiben) -> wenn Du neben den angegeben Farben weitere einfügen möchtest ist die Anpassung einfacher und macht den Code auch schlanker!

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „cry.baby“ ()

    Hi cry.baby & petaod
    Vielen Dank, das Ihr beide Euch Zeit für mich genommen habt. Es funktioniert jetzt.

    Ich hatte allerdings etwas vergessen zu erwähnen.
    In der originalen Tabelle1 sind in Spalte C mal SN: Nr. vorhanden und mal keine vorhanden. (Siehe Anhang)
    Ich möchte das er in Spalte A nur die farblich markiert, wo keine SN: Nr. in Spalte C neben der entsprechenden GV steht. Wenn eine SN: Nr. drin steht, soll er die Zelle unberührt lassen (farblos) und einfach mit dem Zählen zur nächsten GV springen und in der entsprechenden Farbe markieren.
    Denn überall wo eine SN: Nr. vorhanden ist soll in Spalte A grau markiert werden. Alles andere in den Farben zur Tabelle2.

    Das grau markieren habe ich bereits mit einer einfachen IF Abfrage hin bekommen. Allerdings schaffe ich es nicht zu programmieren, das er immer einen Schritt weiter mit den Farben springen soll.

    Habe folgendes für die GV0598 und fabe blau ausprobiert.
    Also eigentlich nur z als Range deklariert
    Die rote Zeile hinzugefügt und in der IF Bedingung den roten Teil als weitere Bedingung hinzugefügt.
    Funktioniert aber nicht so leicht wie ich dachte.

    Visual Basic-Quellcode

    1. With Sheets("Tabelle1")
    2. GezähltGV0598 = 0
    3. Dim z As Range
    5. For Each r In Intersect(Tabelle1.UsedRange, Tabelle1.Range("B:B"))
    6. For Each z In Intersect(Tabelle1.UsedRange, Tabelle1.Range("C:C")) ' <<---
    7. ' vvvvvvvvvv
    8. If r = "GV0598" And z = "" And GezähltGV0598 < AnzahlGV0598_blau Then
    9. GezähltGV0598 = GezähltGV0598 + r.Count
    10. r.Offset(0, -1).Interior.Color = Blau
    12. End If
    13. Next z
    14. Next r
    15. End With
    16. End Sub


    Code-Tags eingefügt. Die Farbe "Rot" ist der Moderation vorbehalten. ~Thunderbolt
    Dateien

    • Test.xlsx

      (11,74 kB, 38 mal heruntergeladen, zuletzt: )

    Dieser Beitrag wurde bereits 3 mal editiert, zuletzt von „Thunderbolt“ ()

    cry.baby schrieb:

    Hast Du vllt noch was vergessen uns zu sagen? Hm? Also irgend ne Spalte nicht erwähnt oder so? <img src="https://www.vb-paradise.de/wcf/images/smilies/biggrin.png" alt=":D" />

    <span style="color: #FF0000"><b>Vollzitat entfernt.</b> ~Thunderbolt</span>


    Glaube nicht oder lass mal überlegen ?(

    Habe das fast fertige Programm mal als Text-Datei angehangen. Funktioniert super.
    Ist aber etwas lang geworden mit 2752 Zeilen....
    Habe auch direkt die Farben die verwendet werden dürfen fest vorgegeben, damit nicht ausversehen eine fremde Farbe genommen werden kann, die dann nicht erkannt wird.
    Habe noch nicht alle GV Nr. integriert. Denke werden am Ende ca. 3000 Zeilen sein.
    Ohne Deinen Code hätte ich das aber nicht geschafft.
    Habe aber trotzdem sehr viel dabei gelernt.
    Ich muss noch irgendwie versuchen, das die Farbwahl individuell sein darf und nicht fest vorgegeben ist.

    Ab und zu kann es vorkammen das ich pro GV Nr. 3 Farben vergeben muss, weil ich 3 Aufträge glaichzeitig geplant habe. Werde mal versuchen Deinen Code daraufhin zu erweitern.
    Lg Wolfgang
    Dateien

    • Planungsliste.txt

      (93,67 kB, 153 mal heruntergeladen, zuletzt: )

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Parawolli“ ()

Facebook
Telefonspende