Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1400to1404
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Umwandeln in ein Modul

Umwandeln in ein Modul
02.01.2015 17:46:54
Ilch

Hallo zusammen
Ich habe mir unten stehenden Code hier aus dem Forum zusammen gebaut. Er hat auch immer sehr gut funktioniert, doch leider ist mein rechner so schwach auf der Brust auf arbeit, das er sich immer aufhängt wenn ich änderungen im Tabellenblatt vornehme. Deshalb wäre es toll wenn mir jemand aus diesem Code ein standartmodul machen könnte so das der code nur einmal ausgeführt wird wenn ich einen Button klicke.
Hier mal der Code:

  • Private Sub Worksheet_Change(ByVal Target As Range)
    Dim pos As Integer
    pos = InStr(Target.Cells(1, 1), "S1")
    If pos > 0 Then
    With Target.Characters(Start:=pos, Length:=2).Font
    .FontStyle = "Fett"
    .ColorIndex = 1
    End With
    End If
    pos = InStr(Target.Cells(1, 1), "S2")
    If pos > 0 Then
    With Target.Characters(Start:=pos, Length:=2).Font
    .FontStyle = "Fett"
    .ColorIndex = 29
    End With
    End If
    pos = InStr(Target.Cells(1, 1), "S3")
    If pos > 0 Then
    With Target.Characters(Start:=pos, Length:=2).Font
    .FontStyle = "Fett"
    .ColorIndex = 3
    End With
    End If
    pos = InStr(Target.Cells(1, 1), "S4")
    If pos > 0 Then
    With Target.Characters(Start:=pos, Length:=2).Font
    .FontStyle = "Fett"
    .ColorIndex = 41
    End With
    End If
    pos = InStr(Target.Cells(1, 1), "S5")
    If pos > 0 Then
    With Target.Characters(Start:=pos, Length:=2).Font
    .FontStyle = "Fett"
    .ColorIndex = 5
    End With
    End If
    End Sub
    


  • Ich hoffe mir kann jemand helfen.
    Viele Grüße und ein frohes neues Jahr
    Ilch

    15
    Beiträge zum Forumthread
    Beiträge zu diesem Forumthread

    Betreff
    Datum
    Anwender
    Anzeige
    AW: Umwandeln in ein Modul
    02.01.2015 17:48:50
    Hajo_Zi
    vielleicht solltest Du den Code auf einen Bereich begrenzen?

    Vorschlag Bereich
    02.01.2015 18:02:42
    Hajo_Zi
    
    Option Explicit                                     ' Variablendefinition erforderlich
    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim RaBereich As Range                          ' Variable für Bereich
    Dim RaZelle As Range                            ' Variable für Zelle
    Dim pos As Integer
    Set RaBereich = Range("L22:M39, O21:O26")       ' Bereich der Wirksamkeit
    ' noch mehr Bereiche
    'Set RaBereich = Union(Range("C11:AG11 , C13:AG13, C15:AG15 , C17:AG17"), _
    '    Range("C35:AE35, C37:AE37, C43:AG43, C45:AG45 , C47:AG47 , C49:AG49"), _
    '    Range("C67:AF67 , C69:AF69 , C75:AG75 , C77:AG77 , C79:AG79 , C81:AG81"), _
    '    Range("C99:AF99 , C101:AF101, C107:AG107 , C109:AG109 , C111:AG111"), _
    '    Range("C127:AG127 , C129:AG129 , C131:AG131 , C133:AG133 , C139:AF139"), _
    '    Range("C155:AG155, C157:AG157 , C159:AG159 , C161:AG161 , C163:AG163"), _
    '    Range("C179:AF179 , C181:AF181, C187:AG187 , C189:AG189 , C191:AG191"))
    ' Zelle die in dem Bereich liegen auf die Variable schreiben
    ' damit werden nur noch die Zellen bearbeitet die im vorgegeben Bereich liegen
    ' jede Zelladresse ist einzeln angegeben
    Set RaBereich = Intersect(RaBereich, Range(Target.Address))
    If Not RaBereich Is Nothing Then
    For Each RaZelle In RaBereich
    With RaZelle
    pos = InStr(.Value.Cells(1, 1), "S1")
    If pos > 0 Then
    With .Value.Characters(Start:=pos, Length:=2).Font
    .FontStyle = "Fett"
    .ColorIndex = 1
    End With
    End If
    pos = InStr(.Value.Cells(1, 1), "S2")
    If pos > 0 Then
    With .Value.Characters(Start:=pos, Length:=2).Font
    .FontStyle = "Fett"
    .ColorIndex = 29
    End With
    End If
    pos = InStr(.Value.Cells(1, 1), "S3")
    If pos > 0 Then
    With .Value.Characters(Start:=pos, Length:=2).Font
    .FontStyle = "Fett"
    .ColorIndex = 3
    End With
    End If
    pos = InStr(.Value.Cells(1, 1), "S4")
    If pos > 0 Then
    With .Value.Characters(Start:=pos, Length:=2).Font
    .FontStyle = "Fett"
    .ColorIndex = 41
    End With
    End If
    pos = InStr(.Value.Cells(1, 1), "S5")
    If pos > 0 Then
    With .Value.Characters(Start:=pos, Length:=2).Font
    .FontStyle = "Fett"
    .ColorIndex = 5
    End With
    End If
    End With
    Next RaZelle
    End If
    Set RaBereich = Nothing                         ' Variable leeren
    End Sub
    
    Gruß Hajo

    Anzeige
    AW: Vorschlag Bereich
    02.01.2015 18:24:21
    Ilch
    Hallo Hajo
    Vielen Dank für die schnelle Antwort.Leider Löst der Code so einen Fehler aus und er wird ja dann trotzdem dauernd aktiviert. Deshalb hätte ich es gerne als Modul, so das ich den Code nur einmal aktvieren brauche um meinen Rechner zu schonen und mein Excel nicht dauernd hängen bleibt.
    Anbei mal der Fehler
    Viele Grüße
    Ilch
    Userbild
    Userbild

    AW: Vorschlag Bereich
    02.01.2015 18:27:45
    Hajo_Zi
    schreibe dort nur Value lösche .cells...
    Gruß Hajo

    Anzeige
    AW: Vorschlag Bereich
    02.01.2015 18:46:33
    Ilch
    Hallo Hajo
    Ich bins schon wieder , das geht leider auch nicht
    siehe Fehler.
    Grüße
    Ilch
    Userbild
    Userbild

    AW: Vorschlag Bereich
    02.01.2015 18:50:25
    hary
    Moin
    Versuchs mal damit.
    Sub Versuch()
    Dim pos As Integer
    Dim a
    Dim i As Long
    Dim farbe As Long
    With Worksheets("Tabelle1").Cells(1, 1)
    a = Split("S1,S2,S3,S4,S5", ",")
    For i = LBound(a) To UBound(a)
    If InStr(1, .Value, a(i)) Then
    pos = InStr(.Value, a(i))
    Select Case a(i)
    Case "S1"
    farbe = 1
    Case "S2"
    farbe = 29
    Case "S3"
    farbe = 3
    Case "S4"
    farbe = 41
    Case "S5"
    farbe = 5
    Case Else
    End Select
    .Characters(Start:=pos, Length:=2).Font.FontStyle = "Fett"
    .Characters(Start:=pos, Length:=2).Font.ColorIndex = farbe
    Exit For
    End If
    .Font.Bold = False
    .Font.ColorIndex = xlAutomatic
    Next
    End With
    End Sub
    

    gruss hary

    Anzeige
    AW: Vorschlag Bereich
    02.01.2015 18:57:42
    Ilch
    Hallo hary
    Vielen Dank für Deine Antwort.
    Ich führe den Code aus er läuft auch ohne Fehlermeldung durch nur umgewandelt wird da leider nichts .Es bleibt alles so wie es ist.
    Grüße
    Ilch

    AW: Vorschlag Bereich
    02.01.2015 19:06:38
    Ilch
    Hallo Hary
    kann ich leider nicht ich habe office 2003 und excel 2003.
    Da geht nur xls
    Grüße Ilch

    AW: Vorschlag Bereich
    02.01.2015 19:08:57
    hary
    Moin
    Hab ich nicht drauf geachtet.
    Dann hier.
    https://www.herber.de/bbs/user/94714.xls
    Ist aber unter 2007 erstellt.
    gruss hary

    Anzeige
    AW: Vorschlag Bereich
    02.01.2015 19:15:04
    Hajo_Zi
    schreibe nur .Value und lösche .Cells...
    Gruß Hajo

    AW: Vorschlag Bereich
    02.01.2015 19:50:18
    Ilch
    Ich schon wieder
    Habe ich gemacht dann kommt der Fehler Objekt fehlt
    Grüße Ilch
    Userbild
    Userbild

    AW: Vorschlag Bereich
    02.01.2015 19:53:17
    Hajo_Zi
    dort lösche .value
    Gruß Hajo

    Anzeige
    AW: Vorschlag Bereich
    02.01.2015 20:10:27
    Ilch
    Hallo Hajo
    Vielen Dank jetzt funktioniert es
    Danke Danke

    Hajo,WS-Change() in ein Sub() ist gewünscht..oT
    02.01.2015 18:07:27
    robert

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige