Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1360to1364
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

Freie Zellen kennzeichnen

Freie Zellen kennzeichnen
13.05.2014 17:08:55
Daniela
Hallo,
ich habe nachfolgenden VBA-Code um leere Zellen je Zeile mittels diagonale Linien zu kennzeichen. Das ganze prüft sich aktuell spaltenweise.
Wenn "E6" ... "F6" ... "G6"... Wert enthält, werden alle freien Zellen senkrecht gekennzeichnet.
Leider stosse ich mit den Spalten an die Grenzen, so das ich das ganze jetzt umstellen muss.
Also wenn "E4"..."E500" Wert enthält sollen alle freien Zellen waagerecht (Bis "BO4" ..."BO500" gekennzeichnet werden. Nachfolgend mein bisheriger Code:
Sub Linien_Ausg()
Dim nCol&, nRow&
Dim rng As Range, rngHeader As Range
Dim oTabelle As Worksheet
Dim LStyle As XlLineStyle
Dim LWeight As Single
Dim LColorIndex As Integer
LStyle = xlDash       'Style
LWeight = xlThin    'Breite
LColorIndex = 0      'Farbe
'Tabelle anpassen
Set oTabelle = Tabelle3
On Error GoTo ErrorHandler:
With Application
.ScreenUpdating = False
.EnableEvents = False
With oTabelle
Kill_Linie oTabelle
nCol = .Cells(5, .Columns.Count).End(xlToLeft).Column
Set rngHeader = FindLeerZelle(.Range("E8", .Cells(5, nCol)), xlCellTypeConstants)
If rngHeader Is Nothing Then Exit Sub
For nRow = 8 To 61
Set rng = FindLeerZelle(.Range(.Cells(nRow, 1), .Cells(nRow, nCol)),  _
xlCellTypeBlanks)
If Not rng Is Nothing Then
Set rng = Intersect(rng, rngHeader.Offset(nRow - 5))
If Not rng Is Nothing Then
With rng.Borders(xlDiagonalDown)
.LineStyle = LStyle
.ColorIndex = LColorIndex
.Weight = LWeight
End With
End If
End If
Next nRow
End With
ErrorHandler:
.ScreenUpdating = True
.EnableEvents = True
End With
If Err.Number  0 Then
MsgBox Err.Description, _
vbCritical + vbMsgBoxSetForeground + vbMsgBoxHelpButton, _
"Error: " & Err.Number, Err.HelpFile, Err.HelpContext
End If
End Sub

Ich bedanke mich für jede Hilfe die mich weiterbringt, da ich mit meinen Fähigkeiten an die Grenzen stosse.
VG

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Freie Zellen kennzeichnen
13.05.2014 17:53:19
Daniel
HI
was meinst du mit "waagrecht gekennzeichnet"?
soll durch jede leere Zelle in der Mitte eine waagrechte Linie gehen?
das geht mit Rahmenlinien meines Wissens nach nicht, dazu müsstest du Linien als Grafikelement erstellen und das ist wahrscheinlich zu aufwendig.
Alternativ könntest du die Zellen mit dem Text "----------" füllen, aber dann sind sie nicht mehr leer (dafür verschwindet aber die Markierung automatisch, wenn du was reinschreibst).
die Rahmenlinien oder eine andere Füllung könntest du auch per Bedingter Formatierung erzeugen, dann müsstest du kein Makro verwenden und alles würde automatisch ablaufen.
Gruß Daniel

Anzeige
AW: Freie Zellen kennzeichnen
13.05.2014 21:09:49
Daniela
Hallo,
Sorry war wohl etwas missverständlich formuliert.
Anbei eine Beispieldatei wovon ich das abgeleitet hatte.
https://www.herber.de/bbs/user/90663.xls
Der Unterschied soll sein die Einträge jetzt waagerecht sein sollen (das Datum in Spalte "B" steht und die zu prüfenden Zellen in Spalte "E" bis "BO"
VG

AW: Freie Zellen kennzeichnen
13.05.2014 21:53:48
Daniel
ich denke, ich habe das schon richtig verstanden.
Gerade Linie als Kennzeichung geht nur über Grafik-Elemente (was ich für zu aufwendig halte) oder als Text mit "-"-Zeichen.
der Code, um leere Zellen mit "-"-Zeichen zu füllen sieht so aus, die Leerzeichen am Anfang und am Ende des Fülltext sind für die korrekte Funktion notwendig:
im Hauptmakro anstelle der Formatierung mit Diagonalrahmenlinien:
               If Not rng Is Nothing Then
rng.Value = " --- "
End If
und das Makro, um die Markierung zu entfernen:
Private Sub Kill_Linie(objTabelle As Object)
With objTabelle
.Range(.Range("B10"), .Cells(50, .UsedRange.Columns.Count)).Replace " --- ", "", xlWhole
End With
End Sub
Gruß Daniel

Anzeige
AW: Freie Zellen kennzeichnen
13.05.2014 22:01:47
Daniel
ok, jetzt sehe ichs auch, aber die Datei hat immer noch das alte Format.
mach mal ne Beispieldatei, wie die Beispieldatei aussehen soll (halt noch mit dem Fehlerhaften Code)
wobei ich immer noch die Bedingte Formatierung anstelle des Codes bevorzugen würde.
Gruß Daniel

AW: Freie Zellen kennzeichnen
14.05.2014 09:27:36
Daniel
und was soll der neue Code jetzt markieren?
mach die Zellen mal von Hand gelb.
Hast du dich schon mal mit der Bedingten Formatierung beschäftigt?
die scheint mir hier die bessere Lösung zu sein.
Gruß Daniel

Anzeige
AW: Freie Zellen kennzeichnen
14.05.2014 09:53:53
Daniela
Der Code soll in jeder Zeile wo in Spalte "B" ein Datum steht alle leeren zellen im Bereich B5 bis E36 mit einer Diagonale versehen.
https://www.herber.de/bbs/user/90669.xls
Mit der bedingten Formatierung habe ich schon tagelang probiert, irgendwie funktioniert das nicht.
MfG

AW: Freie Zellen kennzeichnen
14.05.2014 10:03:56
Daniel
HI
markiere alle Zellen (klick auf den Kreuzungspunkg von Spalten- und Zeilenköpfen) und erstelle eine Bedingte Formatierung mit dieser Formel als Regel (alle Zellen markiert, Zelle A1 ist die aktive Zelle):
=Und(IstZahl($A1);A$5"";A1"")
für diese Regel legst du dann den Diagonalstrich als Format fest.
der Strich wird dann automatisch eingefügt oder entfernt, abhängig davon ob die Zelle befüllt ist oder nicht.
Dadurch dass die Regel für alle Zellen gilt, kannst du die Tabelle broblemlos erweitern, ohne das du was ändern musst.
wenn die Markierung generell an- und abschaltbar sein soll, würde ich sie noch so erweitern:
=Und($A$1="";IstZahl($A1);A$5"";A1"")
dann werden die Diagonalllinen nur angezeigt, wenn Zelle A1 leer ist. Sobald du in A1 was reinschreibst, verschwinden sie.
Damit funktioniert das ganze dann ohne eine Zeile Markocode.
Gruß Daniel

Anzeige
AW: als Makro so
14.05.2014 10:29:52
Daniel
Folgender Makrocode reicht aus:
Sub Test1()
With ActiveSheet.Cells(5, 1).CurrentRegion
Call Loesche_Linie_Button
On Error Resume Next
With .SpecialCells(xlCellTypeBlanks).Borders(xlDiagonalDown)
.Weight = xlThin
.LineStyle = xlDot
End With
On Error GoTo 0
End With
End Sub
Sub Loesche_Linie_Button()
ActiveSheet.Cells.Borders(xlDiagonalDown).LineStyle = xlNone
End Sub
Bedingung ist, dass die Tabelle ringsum von einer vollständigen Leerzeile und Leerspalte umgeben ist, damit .CurrentRegion richtig arbeiten kann (dh Zeile 4 und Spalte F sollten durchgehend leer sein.)
Gruß Daniel

Anzeige
AW: als Makro so
14.05.2014 11:19:48
Daniela
DANKE !! jetzt passt alles !!!

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige