Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.04.2024 00:49:19
Excel Sheet in einen Excel Kalender einfügen
20.04.2024 00:08:11
In Ordner nur das Speichern von Dateien erlauben
19.04.2024 21:26:15
mehrfache Texte finden
19.04.2024 19:41:34
Bei VBA Ausführung Anzeige einfrieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
940to944
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
940to944
940to944
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

bei automatischen einfügen funktioniert makro nich

bei automatischen einfügen funktioniert makro nich
14.01.2008 08:26:00
Jonatan
Hallo,
habe folgendes Makro in meiner Excelliste verwendet.
Dies funktioniert auch einwandfrei, wenn ich in die Spalte D die Werte eintippe und dann Enter drücke.
Ich habe jedoch ein Makro geschrieben, mit dem ich die Daten von Spalte A bis H über Textfelder eingebe und die dann automatisch in die Spalte eingefügt werden.
Wenn die Daten nun automatisch eingefügt werden, funktioniert das "Zeilenfärbmakro" nicht, wenn ich die Daten jedoch von Hand eingeben, gehts.
Woran liegt das?

Private Sub Worksheet_Change(ByVal Target As Range)
Const tThisRange = "D44:D510"         ' Bereich der EingabeZellen
Const iThatOffset = 22             ' Offset zum Bereich in Spalten (links-,rechts+)
Const iNrofColumns = 220            ' Anzahl Spalten nach rechts ab Offsetspalte
Dim lx As Long
If Intersect(Target, ActiveSheet.Range(tThisRange)) Is Nothing Or _
Target.Cells.Count > 1 Then Exit Sub
Select Case LCase(Target.Value)
Case "haus"
For lx = iThatOffset To iThatOffset + iNrofColumns - 1
Target.Offset(0, lx).Interior.ColorIndex = 27
Next lx
Case "auto"
For lx = iThatOffset To iThatOffset + iNrofColumns - 1
Target.Offset(0, lx).Interior.ColorIndex = 43
Next lx
Case "buch"
For lx = iThatOffset To iThatOffset + iNrofColumns - 1
Target.Offset(0, lx).Interior.ColorIndex = 37
Next lx
Case "bild"
For lx = iThatOffset To iThatOffset + iNrofColumns - 1
Target.Offset(0, lx).Interior.ColorIndex = 22
Next lx
Case Else
For lx = iThatOffset To iThatOffset + iNrofColumns - 1
Target.Offset(0, lx).Interior.ColorIndex = xlColorIndexNone
Next lx
End Select
End Sub


vielen dank für eure Hilfe
Gruß Jonatan

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: bei automatischen einfügen funktioniert makro nich
14.01.2008 08:48:13
Renee
Hi Jonathan,
mit dem ich die Daten von Spalte A bis H über auch in Spalte ?
Const tThisRange = "D44:D510" das Makro testet nur auf Veränderungen in diesem Bereich. D.h. es ist ihm völlig wurscht, was du in Spalten A,B,C,E,F,G,H ab Zeile 44 bis Zeile 510 abfüllst.
Zeig mal deinen 'Abfüll-'Code.
GreetZ Renée

AW: bei automatischen einfügen funktioniert makro nich
14.01.2008 09:00:00
Jonatan
Hallo,
klar, es sollen ja auch nur die Daten in D überprüft werden, das mit den Spalten D bis H hab ich nur gesagt, weil um zu sagen, dass es da mehrere Textfelder gibt unter anderem eben das für die Spalte D.
Das ist der "Abfüllcode":
Die Textbox 4 füllt die Spalte D.
Die drei Zeilen AA87 bis IV89 kopiere ich jedesmal um die Formatierung und die Berechnungen von diesen drei Zeilen zu übernehmen.
Leider ändert sich dann aber die Farbe nicht mehr, sondern bleibt wie die aus den kopierten Zellen.

Private Sub CommandButton1_Click()
Dim loLetzte As Long
loLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows. _
Count)
Cells(loLetzte + 3, 1) = TextBox1
TextBox1 = ""
loLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows. _
Count)
Cells(loLetzte + 0, 2) = TextBox2
TextBox2 = ""
loLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows. _
Count)
Cells(loLetzte + 0, 3) = TextBox3
TextBox3 = ""
loLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows. _
Count)
Cells(loLetzte + 0, 4) = TextBox4
TextBox4 = ""
loLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows. _
Count)
Cells(loLetzte + 0, 5) = TextBox5
TextBox5 = ""
loLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows. _
Count)
Cells(loLetzte + 0, 6) = TextBox6
TextBox6 = ""
loLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows. _
Count)
Cells(loLetzte + 0, 7) = TextBox7
TextBox7 = ""
loLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows. _
Count)
Cells(loLetzte + 0, 8) = TextBox8
TextBox8 = ""
loLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows. _
Count)
Cells(loLetzte + 0, 9) = TextBox9
TextBox9 = ""
loLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
Cells(loLetzte + 0, 10) = TextBox10
TextBox10 = ""
loLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows. _
Count)
Cells(loLetzte + 0, 11) = TextBox11
TextBox11 = ""
loLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows. _
Count)
Cells(loLetzte + 0, 12) = TextBox12
TextBox12 = ""
Range("AA87:IV89").Select
Selection.Copy
loLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows. _
Count)
Cells(loLetzte, 26).Select
ActiveSheet.Paste
loLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows. _
Count)
Rows(loLetzte + 6).Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Me.Hide
End Sub


Anzeige
AW: bei automatischen einfügen funktioniert makro nich
14.01.2008 09:11:00
Renee
Hi Jonatan,
die Einschränkung ... 

or Target.Cells.Count > 1

schränkt das funktionieren des 'Färbe'-Makros auf genau 1 Zelle ein. Wenn Du mehrere Zeilen kopierst (in deinem Fall 3) dann steigt das Makro dort aus und färbt die Zeilen nicht ein.
GreetZ Renée

AW: bei automatischen einfügen funktioniert makro nich
14.01.2008 09:31:04
Jonatan
Hallo Renée,
vielen Dank erstmal.
Heißt das, dass ich da größer 3 reinschreiben muss?
Oder wie muss ich das ändern, dass das Makro nicht aussteigt?
Gruß Jonatan

Probier's mit > 3 (owT)
14.01.2008 11:38:00
Renee

AW: Probier's mit > 3 (owT)
14.01.2008 11:46:00
Jonatan
Hallo Renée,
nein, das geht leider auch nicht.
Ich probier das jetzt auf eine anderen Weg zu lösen.
Trotzdem vielen Dank dir!!!
Gruß Jonatan

Anzeige
AW: Probier's mit > 3 (owT)
14.01.2008 12:59:00
Renee
Hi Jonathan,
Dann so:

Private Sub Worksheet_Change(ByVal Target As Range)
Const tThisRange = "D44:D510"         ' Bereich der EingabeZellen
Const iThatOffset = 22             ' Offset zum Bereich in Spalten (links-,rechts+)
Const iNrofColumns = 220            ' Anzahl Spalten nach rechts ab Offsetspalte
Dim rC As Range
Dim lx As Long
If Intersect(Target, ActiveSheet.Range(tThisRange)) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each rC In Target.Cells
Select Case LCase(rC.Value)
Case "haus"
For lx = iThatOffset To iThatOffset + iNrofColumns - 1
rC.Offset(0, lx).Interior.ColorIndex = 27
Next lx
Case "auto"
For lx = iThatOffset To iThatOffset + iNrofColumns - 1
rC.Offset(0, lx).Interior.ColorIndex = 43
Next lx
Case "buch"
For lx = iThatOffset To iThatOffset + iNrofColumns - 1
rC.Offset(0, lx).Interior.ColorIndex = 37
Next lx
Case "bild"
For lx = iThatOffset To iThatOffset + iNrofColumns - 1
rC.Offset(0, lx).Interior.ColorIndex = 22
Next lx
Case Else
For lx = iThatOffset To iThatOffset + iNrofColumns - 1
rC.Offset(0, lx).Interior.ColorIndex = xlColorIndexNone
Next lx
End Select
Next
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub


Greet Renée

Anzeige

Links zu Excel-Dialogen

CommandButton TextBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige