Hallo Ihr Lieben,
ich habe jetzt schon gefühlt komplett Google durchsucht nach einer Lösung.. Ich bin leider Anfänger was Makros angeht... ich schreibe mir aus verschiedenen immer mal was zusammen.
Jetzt benötige ich aber eure Hilfe...
Ich suche ein Makro, welches mit nach Vorgabe (Zahl) eine bestimmte Anzahl von Zellen nach rechts oder links einfärbt und/oder eine 1 reinschreibt...
Das heißt, ich schreibe in C6 eine 5 und dann soll Excel mir die Zellen (5 Stück) in einem Bereich von G6:AL6 einfärben oder halt eine 1 reinschreiben.
moinmoin
eine Möglichkeit
Code:
Sub test()
Dim lngLaenge As Long
lngLaenge = Range("C6").Value
Range("G6:AL6").Clear
Cells(6, 7).Resize(1, lngLaenge).Value = 1
Cells(6, 7).Resize(1, lngLaenge).Interior.ColorIndex = 6
End Sub
MfG Tom
(29.11.2017, 07:58)Crazy Tom schrieb: [ -> ]moinmoin
eine Möglichkeit
Code:
Sub test()
Dim lngLaenge As Long
lngLaenge = Range("C6").Value
Range("G6:AL6").Clear
Cells(6, 7).Resize(1, lngLaenge).Value = 1
Cells(6, 7).Resize(1, lngLaenge).Interior.ColorIndex = 6
End Sub
MfG Tom
Dankeschön :) Das funktioniert ja richtig spitze.
Wie müsste ich den Code den anpassen, wenn ich das über mehrere Zeilen hätte? (Beispiel angehängt)
Muss ich dann einfach ab "Cells..." bis "=6" kopieren und einfach nur anpassen?
Nachtrag: Kann man eventuell die Tabelle irgendwie beibehalten?
Moin!
Beides geht ohne VBA.
Beachte das ben. def. Zahlenformat, die Formel und die bedingte Formatierung.
Alles drei wird angewendet auf den Bereich [F6:Z6]
Statt Z geht natürlich auch beliebig weit rechts, je nachdem, was Dein beabsichtigtes Maximum in C6 ist.
Zelle | Formel |
F6 | =N(SPALTE(A1)<=$C6) |
Zelle | bedingte Formatierung... | Format |
F6 | 1: F6=1 | abc |
Verwendete Systemkomponenten: [Windows (32-bit) NT 10.00] MS Excel 2016 |
Diese Tabelle wurde mit Tab2Html (v2.6.0) erstellt. ©Gerd alias Bamberg |
Gruß Ralf
Zu Deiner letzten Frage:
Bei mir musst Du die Bereiche der drei Einstellungen einfach nur erweitern.
Ich lade die erweiterte Datei mal hoch.
Hallo
dann würde ich es gleich bei Eingabe in eine Zelle in Spalte C auslösen
dazu diesen Code in das Tabellenblattmodul
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngLaenge As Long
If Not IsNumeric(Target.Value) Then Exit Sub
If Not Intersect(Target, Range("C6:C100")) Is Nothing Then
lngLaenge = Cells(Target.Row, 3).Value
Range(Cells(Target.Row, 7), Cells(Target.Row, "AL")).Clear
Cells(Target.Row, 7).Resize(1, lngLaenge).Value = 1
Cells(Target.Row, 7).Resize(1, lngLaenge).Interior.ColorIndex = 6
End If
End Sub
hier wirkt der Code bei Eingabe einer Zahl in den Zellen C6 bis C100
MfG Tom
Hallo
ach du hast noch Rahmenlinien drin
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngLaenge As Long
If Not IsNumeric(Target.Value) Then Exit Sub
If Not Intersect(Target, Range("C6:C100")) Is Nothing Then
lngLaenge = Cells(Target.Row, 3).Value
Range(Cells(Target.Row, 7), Cells(Target.Row, "AL")).ClearContents
Range(Cells(Target.Row, 7), Cells(Target.Row, "AL")).Interior.ColorIndex = xlNone
Cells(Target.Row, 7).Resize(1, lngLaenge).Value = 1
Cells(Target.Row, 7).Resize(1, lngLaenge).Interior.ColorIndex = 6
End If
End Sub
MfG Tom
(29.11.2017, 08:09)Crazy Tom schrieb: [ -> ]Hallo
dann würde ich es gleich bei Eingabe in eine Zelle in Spalte C auslösen
dazu diesen Code in das Tabellenblattmodul
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngLaenge As Long
If Not IsNumeric(Target.Value) Then Exit Sub
If Not Intersect(Target, Range("C6:C100")) Is Nothing Then
lngLaenge = Cells(Target.Row, 3).Value
Range(Cells(Target.Row, 7), Cells(Target.Row, "AL")).Clear
Cells(Target.Row, 7).Resize(1, lngLaenge).Value = 1
Cells(Target.Row, 7).Resize(1, lngLaenge).Interior.ColorIndex = 6
End If
End Sub
hier wirkt der Code bei Eingabe einer Zahl in den Zellen C6 bis C100
MfG Tom
Dankeschön :)
Ich bekomme es leider nicht eingefügt :( Ich sage ja ich bin Anfänger...
Gerade als Anfänger solltest Du imo Makros nur dann nutzen, wenn sie signifikante Vorteile bieten, was hier nicht der Fall ist.
Hast Du Dir meine Datei mal angesehen?
By the way:
Nutze zum Antworten den gleichnamigen Button und zitiere nicht unnötig.
Gruß Ralf