Microsoft Excel

Herbers Excel/VBA-Archiv

Effektiv Code-Zeilen sparen

Betrifft: Effektiv Code-Zeilen sparen von: Richard
Geschrieben am: 11.08.2008 11:31:56

Hallo,

möchte mal gern wissen, wie ich nachfolgenden Code so umschreiben kann, dass ich den nicht 50 mal für jede neue Zeile kopieren muss. Sicherlich denkt jetzt einer, warum so ein langer Code, wenn man dass doch ganz einfach über "Extras" -> "Schutz" - >"Blatt schützen..." -> "das Häcken bei 'gesperrte Zellen auswählen' rausnimmt" lösen könnte. Ja das weiß ich, möchte ich aber nicht. ;-)

Mir geht es wirklich nur darum diesen funktionsfähigen Code so schreiben, dass er für 50 weitere Zeilen funktioniert ohne den code so oft kopieren zu müssen.

Mit freundlichen Grüßen

Richard

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("E10")) Is Nothing Then
    Range("G10").Select
  End If
  
  If Not Intersect(Target, Range("G10")) Is Nothing Then
    Range("M10").Select
  End If

  If Not Intersect(Target, Range("M10")) Is Nothing Then
    Range("O10").Select
  End If

  If Not Intersect(Target, Range("O10")) Is Nothing Then
    Range("Q10").Select
  End If

  If Not Intersect(Target, Range("Q10")) Is Nothing Then
    Range("S10").Select
  End If

  If Not Intersect(Target, Range("S10")) Is Nothing Then
    Range("U10").Select
  End If

  If Not Intersect(Target, Range("U10")) Is Nothing Then
    If Range("W10").Value = "JA" Then
      Range("C10,E10,G10,I10,K10,M10,O10,Q10,S10,U10,W10").Select
      Selection.Interior.ColorIndex = 35
      Selection.Font.ColorIndex = 10
      Range("E11").Select
    Else
      Range("C10,E10,G10,I10,K10,M10,O10,Q10,S10,U10,W10").Select
      Selection.Interior.ColorIndex = 38
      Selection.Font.ColorIndex = 53
      Range("E11").Select
    End If
  End If

End Sub


  

Betrifft: AW: Effektiv Code-Zeilen sparen von: Tobias
Geschrieben am: 11.08.2008 11:42:22

Hallo Richard!
Sehr interessanter Code. Was genau willst Du bezwecken? Immer wenn eine "ungerade" Spalte (E, G, usw) und Zeile 10 markiert ist die Markierung um 2 Spalten verschieben? Ausnahme falls Spalte G dann springe bis M?

Ich würde das Spalten-Springen lieber so lösen:

If Target.Row = 10 And Target.Column Mod 2 = 1 Then
Target.Offset(0, 2).Select
End If

Bau noch ein paar Abfragen, zum Beispiel für Spalte G, ein.

Schönen Gruß, Tobias
http://www.tobiasschmid.de/


  

Betrifft: AW: Effektiv Code-Zeilen sparen von: Richard
Geschrieben am: 11.08.2008 11:57:49

Hallo Tobias,

folgendes will ich damit bezwecken.

siehe Screenshot:



Ich beginne meine Eingabe in Zelle E10. Die Position in C10 wird per Formel eingefügt. Nach Fertigstellung der Eingabe soll er einfach ins nächste Feld springen. Spalte I und Spalte K werden deshalb übersprungen, weil deren Eingabe nur in den seltensten Fällen erforderlich ist. In Spalte W befindet sich eine SVERWEIS-Formel, die Eingabe in Spalte U mit einer anderen Tabelle vergleicht.
Der erwähnte Code markiert bei Eingabe der Zelle U10 anhand des Wertes in Spalte W sprich "Ja" oder "Nein" die Zeile rot oder grün. Danach spring in die nächste Zeile.

Das soll mein Code bezwecken.

MfG

Richard


  

Betrifft: AW: Effektiv Code-Zeilen sparen von: Tobias
Geschrieben am: 11.08.2008 12:07:49

Hallo Richard!
Jetzt bin ich dabei. Es geht Dir nicht darum die existierenden Codezeilen zu optimieren, nur darum die nächsten 50 Zeilen im Exceldokument "genauso" ab zu arbeiten.

Ich denke, dass Du hiermit weiterkommen müsstest:

If Not Intersect(Target, Range("M10:M60")) Is Nothing Then
Target.Offset(0,2).Select
End If

Ich prüfe zunächst ob irgendeine Zelle in Spalte M, Zeile 10 bis 60 markiert ist und dann springt die Markierung 2 Spalten nach rechts. Den Rest kannst Du sicher selber anpassen.

Besser?
Schönen Gruß, Tobias
http://www.tobiasschmid.de/


  

Betrifft: AW: Effektiv Code-Zeilen sparen von: Daniel
Geschrieben am: 11.08.2008 12:33:21

Hi

so vielleicht:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row >= 10 Then
    If Target.Columns.Count = 1 Then
        Select Case Target.Column
            Case 5, 7, 9, 11, 13, 15, 17, 19
                Target.Offset(0, 2).Select
            Case 21
                If Target.Offset(0, 2).Value = "JA" Then
                    With Range("C1,E1,G1,I1,K1,M1,O1,Q1,S1,U1,W1")
                        .Offset(Target.Row - 1).Interior.ColorIndex = 35
                        .Offset(Target.Row - 1).Font.ColorIndex = 10
                    End With
                Else
                    With Range("C1,E1,G1,I1,K1,M1,O1,Q1,S1,U1,W1")
                        .Offset(Target.Row - 1).Interior.ColorIndex = 38
                        .Offset(Target.Row - 1).Font.ColorIndex = 53
                    End With
                End If
                Cells(Target.Row + 1, 5).Select
            Case Else
        End Select
    End If
End If
End Sub



wobei ich das Färben der Zeilen eher über bedingte Formatierung regeln würde.
dann ändert sich auch die Farbe mit, wenn sich der Wert in Spalte W nachträglich ändert.

Gruß, Daniel


  

Betrifft: AW: Effektiv Code-Zeilen sparen von: Richard
Geschrieben am: 11.08.2008 13:05:15

Hallo Daniel, hallo Tobias,

vielen Dank für eure Hilfe, der fertige Code hat mich wirklich sehr beeindruckt - wirklich hervorragend.
Jedoch überspringt er die Spalten I und K nicht mehr und es wäre hilfreich, wenn ich die letzte Zelle bearbeitet habe, sprich U59, dass er danach wieder an den Anfang springt!
Ansonsten wirklich klasse. Danke vielmals!

Mit freundlichen Grüßen

Richard


  

Betrifft: Oh... ich war zu schnell von: Richard
Geschrieben am: 11.08.2008 13:08:58

Sorry,

mit


Case 7
  Target.Offset(0, 6).Select



krieg ich das überspringen von I und K hin... da war ich etwas zu schnell mit der Kritik ;-)


  

Betrifft: AW: Oh... ich war zu schnell von: Tobias
Geschrieben am: 11.08.2008 13:12:34



Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row >= 10 Then
    If Target.Columns.Count = 1 Then
        Select Case Target.Column
            Case 7
                Target.Offset(0, 6).Select
            Case 5, 7, 9, 11, 13, 15, 17, 19
                Target.Offset(0, 2).Select
            Case 21
                If Target.Offset(0, 2).Value = "JA" Then
                    With Range("C1,E1,G1,I1,K1,M1,O1,Q1,S1,U1,W1")
                        .Offset(Target.Row - 1).Interior.ColorIndex = 35
                        .Offset(Target.Row - 1).Font.ColorIndex = 10
                    End With
                Else
                    With Range("C1,E1,G1,I1,K1,M1,O1,Q1,S1,U1,W1")
                        .Offset(Target.Row - 1).Interior.ColorIndex = 38
                        .Offset(Target.Row - 1).Font.ColorIndex = 53
                    End With
                End If
                If Target.Row < 59 Then
                    Cells(Target.Row + 1, 5).Select
                Else
                    Cells(10, 5).Select
                End If
            Case Else
        End Select
    End If
End If
End Sub

Code eingefügt mit Syntaxhighlighter 4.14



Ich hoffe es passt so, Tobias
http://www.tobiasschmid.de/


  

Betrifft: AW: Oh... ich war zu schnell von: Daniel
Geschrieben am: 11.08.2008 13:35:37

Hi

jup, genau so (ich hatte die Beschränkung auf 60 Zeilen ignoriert)

noch 2 kleine korreturen:

1. die Beschränkung auf max Zeile 60:

If Target.Row >= 10 and Target.row <= 60 Then



2. da für die Spalte 7 ein eingener CASE-Fall besteht, sollte die 7 nicht mehr in den anderen CASE-Fällen erscheinen. Die Spalten 9 und 11 sind dann auch keine Eingabefelder mehr, daher sollten sie im 2. Case-Fall nicht mehr aufgeführt werden:

Case 5, 13, 15, 17, 19



Gruß, Daniel


  

Betrifft: AW: Oh... ich war zu schnell von: Richard
Geschrieben am: 11.08.2008 13:42:42

Hallo Daniel,

zu 2: Spalte 7 hatte ich auch aus dem einen Case-Fall rausgenommen. Die Spalten 9 und 11 sind schon Eingabefelder, die aber sehr sehr selten benötigt werden. Sollte ich diese benötigen, dann geh ich mit der Maus oder Pfeiltasten da rein und dann ist es nett, wenn sie sich so verhalten, wie die anderen auch, von daher kann ich den Case-Fall so lassen.

Aber diese Case-Geschichte an sich kannte ich noch gar nicht. Das bringt mich in vielen Dingen viel weiter.

Danke nochmals!

Gruß
Richard