Zellen, Zeilen, Spalten und Farbe bedingt anpassen

  • Excel

Es gibt 13 Antworten in diesem Thema. Der letzte Beitrag () ist von France.

    Zellen, Zeilen, Spalten und Farbe bedingt anpassen

    Hallo an Alle,

    und zwar hab ich ein kleines Problem, welches ich schon einmal gepostet habe aber keine Zufriedenstellende Antwort bekommen habe.

    Und Zwar habe ich einen Code, der meine Spalten und Zeilen erweitert. Das funtioniert auch super, das Problem ist, wenn ich Zellen, Zeilen, Spalten wieder entferne, passt er dies nicht wieder automatisch an.

    Z. B. Wenn ich "WP" zwischen den Zeilen, "WP1300 und "WP1100" die Zelle "WP1200" lösche, soll sich diese wieder automatisch anpassen, sodass aus "WP1300" wieder "WP1200" wird.

    Zu dem hab ich noch ein rein kosmetisches Problem, das mich imens stört.

    Und zwar hab ich eine Färbung, wie man in dem Code sehen, kann mit eingefügt, dass die Zellen auf Knopfdruck färbt. Allerdings färbt es auch die nachfolgenden Zellen, die nicht gefärbt werden sollen, kann ich das irgendwie abschalten, dass die Farbe nicht auf die benachbarten Zellen übertragen werden?


    Da ich nicht weis, wie ich hier in diesem Forum, die Zellen aus dem Excel ins Forum übertrage hab ich einen Screenshot davon gemacht und es mal angehängt.


    Hier in der angehängten Abbildung seht ihr auch mein kosmetisches Proble, welches mich so stört.


    Hier der Code zu meinem Hauptproblem und Färbung:


    [line] [/line]
    Code:

    Visual Basic-Quellcode

    1. Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    3. Application.EnableEvents = False
    4. If Intersect(Target, Range("A1:Z1000")) Is Nothing Then Application.EnableEvents = True: Exit Sub
    5. If ActiveCell.Interior.ColorIndex = 24 Then
    6. ActiveCell.Interior.ColorIndex = 3
    7. ActiveCell.Font.Strikethrough = True
    8. ActiveCell.Interior.ColorIndex = 3
    9. Else
    10. ActiveCell.Interior.ColorIndex = 24
    11. ActiveCell.Font.Strikethrough = False
    13. End If
    14. Application.EnableEvents = True
    16. End Sub
    22. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    23. If Target.Count = 1 Then
    24. If Target.Column Mod 2 = 0 Then 'Feld selektiert zwischen den Columns B D F
    25. neue_column Target
    26. ElseIf Target.Row Mod 3 = 0 Then 'Feld selektiert zwischen den Reihen 3,6,9,12
    27. verschiebe_rows Target
    28. End If
    29. End If
    31. 'Besäubern
    32. zwischen_reihen_löschen
    34. Berechnung_wp
    35. End Sub
    36. Sub Berechnung_wp()
    38. Dim i As Integer
    39. i = 1
    41. Do While Tabelle1.Cells(2, i) <> "" 'Ist die Column überhaupt befüllt?
    42. Dim n As Integer
    43. n = 2 'Inhaltfeld auswählen, nicht das WP Feld
    44. Do While Tabelle1.Cells(n, i) <> "" 'Hat die Zelle einen Inhalt
    45. Dim wp As Integer
    47. 'Berechnung des WP Werts
    48. wp = 900 + Math.Round(i / 2.1, 0) * 1000 + Math.Round((n / 3), 0) * 100
    50. 'Befüllen der Zeile unter dem WP
    51. Tabelle1.Cells(n - 1, i).Value = "WP" & wp
    53. n = n + 3 ' Row 1 4 7 10 ...
    54. Loop
    56. i = i + 2 'Column A C E G
    57. Loop
    58. End Sub
    59. Sub neue_reihe(ByVal Target As Range)
    60. For i = 0 To 2
    61. ActiveCell.EntireRow.Insert
    62. Next
    63. Tabelle1.Cells(Target.Row - 1, Target.Column).Select
    64. End Sub
    65. Sub neue_column(ByVal Target As Range)
    66. For i = 0 To 1
    67. Target.EntireColumn.Insert
    68. Next
    70. Tabelle1.Cells(2, Target.Column - 1).Value = "Neu"
    71. Tabelle1.Cells(2, Target.Column - 1).Select
    73. End Sub
    74. Sub verschiebe_rows(ByVal Target As Range)
    75. Dim verschieber(4) As String
    77. For i = Target.Row + 1 To 100
    79. verschieber(4) = verschieber(3)
    80. verschieber(3) = verschieber(2)
    81. verschieber(2) = verschieber(1)
    85. verschieber(1) = Tabelle1.Cells(i, Target.Column)
    86. Tabelle1.Cells(i, Target.Column).Value = verschieber(4)
    88. Next
    89. Tabelle1.Cells(Target.Row + 2, Target.Column).Value = "Neu"
    90. Tabelle1.Cells(Target.Row + 2, Target.Column).Select
    91. End Sub
    92. Sub zwischen_reihen_löschen()
    93. 'Unbenutze Columns
    94. For i = 1 To last_column
    95. If Tabelle1.Cells(2, i).Value = "" And Tabelle1.Cells(2, i + 1).Value = "" Then
    96. Dim extra_range1 As Integer
    97. If Tabelle1.Cells(2, i + 2).Value = "" Then
    98. extra_range1 = 3
    99. Else
    100. extra_range1 = 2
    101. End If
    102. Range(Tabelle1.Cells(1, i), Tabelle1.Cells(1, i + extra_range1)).EntireColumn.Delete
    103. End If
    104. Next
    106. End Sub
    107. Function last_column()
    108. Dim Last As Long
    109. Last = Cells.Find("*", SearchOrder:=xlByColumns, _
    110. LookIn:=xlValues, SearchDirection:=xlPrevious).Column
    111. last_column = Last
    112. End Function

    [line] [/line]


    Ich hoffe, Ihr könnt mir evtl, weiterhelfen.


    Viele Grüße


    France



    Edit by Dodo:
    -> Topic verschoben (Grundlagen => VBA)
    Bilder

    • Excel Ansicht.gif

      26,88 kB, 1.191×531, 306 mal angesehen

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

    wie wäre es denn einfach mit ner eigenen Formatierung? Ab Excel2007 sind die möglichkeiten, der bedingten Formatierung in Excel doch fast grenzenlos, ich würde fast behaupten das kriegste mit Excel boardmitteln locker erldigt ohne eine Zeile Code..

    Naja Schade, dass sich keiner meinem Problem widmen möchte...

    Es geht ja hauptsächlich darum, dass der Code schon erstellt wurde auch zum teil funktioniert, aber nicht ganz so wie ich es mir vorgestellt hatte.
    Das Problem ist einfach, dass ich das durch die bedingte Formatierung nicht hinbekomme, vor allem nicht das, dass sich die zellen automatisch erweitern sollen, sowie, dass es sich automatisch wieder anpasst, wenn man die Zelle mit dem Inhalte "WP..." entfernt.

    Das ganze mach ich ja eben deswegen um einen Automatismus rein zu bekommen, aber über die bedingte Formatierung leider nicht möglich.
    Und warum soll ich denn ein Haus wieder niederreißen, wenn der Rohbau schon steht?

    Wenn mir jemand mit VBA weithelfen könnte, wäre ich sehr dankbar.


    Viele Grüße



    France

    In dem Bild, das ich hochgeladen habe, sieht man z. B. in der zweiten Spalte, dass wenn ich ein Rechtsklick auf eine beschriftete Zelle mache und dann, in die benachbarte unbeschriftete Zelle, also in Spalte "B" klicke, wird die Farbe, leider direckt mitübertragen, nun weis ich allerdings nicht, wie ich das so ändern kann, dass nur die jeweilige "Markierte Zelle" gefärbt wird und nicht die anderen mit, sobald um eine Spalte erweitert wird.

    das ist der farbliche Teil des Codes, welcher die Zellen per Rechtsklick färben soll:


    Visual Basic-Quellcode

    1. Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    3. Application.EnableEvents = False
    4. If Intersect(Target, Range("A1:Z1000")) Is Nothing Then Application.EnableEvents = True: Exit Sub
    5. If ActiveCell.Interior.ColorIndex = 24 Then
    6. ActiveCell.Interior.ColorIndex = 3
    7. ActiveCell.Font.Strikethrough = True
    8. ActiveCell.Interior.ColorIndex = 3
    9. Else
    10. ActiveCell.Interior.ColorIndex = 24
    11. ActiveCell.Font.Strikethrough = False
    13. End If
    14. Application.EnableEvents = True
    16. End Sub



    Danke schonmal im Voraus

    nunja nur die markierte Zelle wird gefärbt, wenn du einfach den Range deiner function nutzt.

    Visual Basic-Quellcode

    1. Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    2. Target.interior.colorindex = 12
    3. End Sub

    Aber das ganze ist immer noch ein fall für die formatierung... anhand welcher Kriterien färbst du die Zelle, das versteh ich immer noch net so ganz..
    Wenn die Zelle ne Hintergrund farbe 24 hat dann soll se 3 haben?

    naja, ich bin ja in VBA erst ein Anfänger, deswegen versuch ich es eben durch learning by doing, auch wenn das "leraning" manchmal dabei einfach untergeht und ich das eine oder andere nicht wirklich verstehe, funktionieren tut es manchmal trotzdem ;)

    An sich gibt es kein Kriterium, es soll meinen Kollgen nur helfen die Übersicht zu behalten. Natürlich könnte man das jedes mal formatieren, aber die Zeit fehlt uns einfach und deswegen versuchen wir, vielerlei Dinge, die Ständig gebraucht werden zu automatisieren.
    Ziel der Färbung war es, bestimmte Felder einfach durch einen rechts-Klick zu Färben und zu Markieren, d.h. Blau, sollte einfach Standart sein und Rot und durchgestrichen für abewählt gelten.

    Mir ging es darum, dass ich mit jeweils einem Klick, die Zelle entweder Rot und durchgestrichen, oder Blau markieren kann. Das ist ja auch gelungen und fuktioniert.
    Sorry, wenn ich mich manchmal vielleicht nicht richtig ausdrücke, aber wenn du was nicht verstehst bitte einfach nochmal nachfragen.

    ok =) nun kommen wir doch schon näher =)
    dann halt den Code von oben...
    ensprechend mit einer Abfrage angepasst.

    Visual Basic-Quellcode

    1. Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    2. if Target.color = blau then
    3. Target.color = red
    4. else
    5. Target.color = blau
    6. end if
    7. End Sub

    Hab mal meinen alten raus genommen und deinen eingefügt nun funtkioniert er leider nicht mehr :-/
    vorher hat er ja funtkioniert, nur kam da das Problem mit den Spalten, die ich erweitert hatte, nämlich das Problem, das die neue Spalte mitgefärbt wurde :-/

    Hab den Code, dann etwas umgeschrieben und funtioniert leider auch nicht so, wie ich es mir vorstellt habe, sprich der code färbt zwar wie gewüscht, jedoch hab ich immernoch das Problem, dass die benachbarte Spalte gefärbt wird.

    Visual Basic-Quellcode

    1. Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    3. Application.EnableEvents = False
    4. If Intersect(Target, Range("A1:Z1000")) Is Nothing Then Application.EnableEvents = True: Exit Sub
    5. If Target.Interior.ColorIndex = 24 Then
    6. Target.Interior.ColorIndex = 3
    7. Target.Font.Strikethrough = True
    8. Target.Interior.ColorIndex = 3
    9. Else
    10. Target.Interior.ColorIndex = 24
    11. Target.Font.Strikethrough = False
    13. End If
    14. Application.EnableEvents = True
    16. End Sub



    Schau dir mal das Bild, an welches ich als am Anfang hochgeladen habe, dann erkennst du auch gleich das Problem, welches ich habe.



    Falls noch wer eine Idee hätte, würde ich mich sehr über eure Hilfe freuen.



    Viele Grüße


    France

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

Facebook