Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1452to1456
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

Tabelle formatieren

Tabelle formatieren
26.10.2015 21:16:37
Thomas
Hallo Excelfreunde,
leider habe ich noch ein Problem,
dies beschäftigt mich schon den ganzen tag. Einige Sachen konnte ich mit eurer Hilfe schon einbauen. Nur ich komme schon wieder nicht weiter.
Ich möchte gern eine Tabelle formatieren. Das untenstehende macro funktioniert schon am besten von all meinen versuchen. Nur leider bekomme ich keinen dicken Rahmen und keine dünnen Rahmen hin und die Überschrift will auch nicht klappen. Da ich dies schwer erklären kann habe ich eine testdatei erstellt. In dieser befinden sich eigentlich meine versuche und ein Wunschergebnis.
Mit dem Versuch Macro formatieren3 geht es auch bestimmt irgentwie hier ist das problem ich bekomme zwar gezielt die Zeile angesprochen aber dann formatiere ich wieder die gesamte zeile. anstatt nur von Spalte b bis m .
hat noch jemand Lust dies sich mal anzuschauen? ich schaffe es einfach nicht.
liebe grüsse thomas
https://www.herber.de/bbs/user/101048.xlsm
Sub formatieren_ausgang()
Dim lngUeberschriftRow As Long, lngLastRow As Long, lngFirstRow As Long
Dim lngSpesenCol As Long, lngNameCol As Long, lngI As Long, letztezeile As Long
Dim strQuellueberschrift As String, strSpesen As String, strTabelle As String
On Error GoTo ErrExit
strQuellueberschrift = "Name"
strSpesen = "Rechnung"
strTabelle = "Tabelle1"
With Sheets(strTabelle)
lngUeberschriftRow = .Cells.Find(strQuellueberschrift, LookAt:=xlWhole).Row
lngNameCol = .Rows(lngUeberschriftRow).Find(strQuellueberschrift, LookAt:=xlWhole).Column
lngSpesenCol = .Rows(lngUeberschriftRow).Find(strSpesen, LookAt:=xlWhole).Column
lngFirstRow = .Cells(lngUeberschriftRow, lngNameCol).Row
letztezeile = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
lngLastRow = Sheets(strTabelle).Cells(Rows.Count, lngNameCol).End(xlUp).Row
Sheets(strTabelle).Cells(lngUeberschriftRow, lngNameCol).Select ' Spalte Namen markieren
Selection.CurrentRegion.Select                '  Bereich markieren
If Selection.Columns.Count > 1 Then
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End If
' Formatieren
For lngI = lngUeberschriftRow To lngLastRow
.Range(Sheets(strTabelle).Cells(lngI, lngNameCol), Sheets(strTabelle).Cells(lngI,  _
lngSpesenCol)).Font.Bold = .Cells(lngI, lngNameCol).Value Like "*Gesamtergebnis*"
.Range(Sheets(strTabelle).Cells(lngI, lngNameCol), Sheets(strTabelle).Cells(lngI,  _
lngSpesenCol)).Font.Bold = .Cells(lngI, lngNameCol).Value Like "*Name*"
.Range(Sheets(strTabelle).Cells(lngI, lngNameCol), Sheets(strTabelle).Cells(lngI,  _
lngSpesenCol)).Font.Bold = .Cells(lngI, lngNameCol).Value Like "*Ergebnis*"
.Range(Sheets(strTabelle).Cells(lngI, lngNameCol), Sheets(strTabelle).Cells(lngI,  _
lngSpesenCol)).Interior.ColorIndex = IIf(Sheets(strTabelle).Cells(lngI, lngNameCol).Value Like "*Ergebnis*", 34, xlColorIndexNone)
.Range(Sheets(strTabelle).Cells(lngI, lngNameCol), Sheets(strTabelle).Cells(lngI,  _
lngSpesenCol)).BorderAround ColorIndex:=IIf(Sheets(strTabelle).Cells(lngI, lngNameCol).Value Like "*Ergebnis*", 1, xlThick = 4)
Next
' Rahmen um Zellen zeichnen
ErrExit:
With Err
If .Number  0 Then
MsgBox "Fehler in Prozedur:" & vbTab & "Fehler Spalten_uhrzeiten_formatieren'" & vbLf &  _
String(60, "_") & vbLf & vbLf & _
IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & "Fehlernummer:" & vbTab & _
_
.Number & vbLf & vbLf & "Beschreibung:" & vbTab & .Description & vbLf, vbExclamation +  _
_
vbMsgBoxSetForeground, "VBA - Fehler in Prozedur - daten"
.Clear
End If
End With
End With
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Tabelle formatieren
27.10.2015 00:16:29
Esmo
Moin Thomas,
wenn Du in Deinem Code schreibst Rows(t).Font.bold, dann wird auch die ganze Reihe markiert.
Durch
 If Cells(t, 2).Value Like "*Ergebnis*" Then                                                   ' _
Value = "test" Then
With Range(Cells(t, 2), Cells(t, 13))
.Font.Bold = True
.VerticalAlignment = xlCenter
.Font.Underline = xlUnderlineStyleDoubleAccounting
.Borders.Weight = 4   '  fetter Rahmen
End With
End If

wird nur der Bereich von Spalte 'B' bis 'M' markiert. Probier mal das:
Sub formatieren4()
Dim strTabelle As String, strSpesen As String, strQuellueberschrift As String
Dim lngUeberschriftRow As Long, lngLastRow As Long, lngFirstRow As Long
Dim lngSpesenCol As Long, lngNameCol As Long, lngI As Long, letztezeile As Long
Dim tz As Long
strTabelle = "Tabelle1"
strQuellueberschrift = "Name"
strSpesen = "Rechnung"
With Sheets(strTabelle)
lngUeberschriftRow = .Cells.Find(strQuellueberschrift, LookAt:=xlWhole).Row
lngNameCol = .Rows(lngUeberschriftRow).Find(strQuellueberschrift, LookAt:=xlWhole).Column
lngSpesenCol = .Rows(lngUeberschriftRow).Find(strSpesen, LookAt:=xlWhole).Column
'    lngFirstRow = .Cells(lngUeberschriftRow, lngNameCol).Row
letztezeile = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
lngLastRow = Sheets(strTabelle).Cells(Rows.Count, lngNameCol).End(xlUp).Row
End With
For tz = lngLastRow To lngUeberschriftRow Step -1
With Range(Sheets(strTabelle).Cells(tz, 2), Sheets(strTabelle).Cells(tz, 13))
.VerticalAlignment = xlCenter
If Cells(tz, 2).Value Like "*Ergebnis*" Then
Cells(tz, 2).Font.Bold = True
Cells(tz, 13).Font.Bold = True
'.Font.Underline = xlUnderlineStyleDoubleAccounting
.Interior.ColorIndex = 34
.BorderAround Weight:=xlThick
Cells(tz, 2).BorderAround Weight:=xlThick
Cells(tz, 13).BorderAround Weight:=xlThick
Else
.Borders(xlInsideVertical).Weight = xlThin
.BorderAround Weight:=xlThin
End If
End With
Next tz
' Kopfzeile
With Range(Sheets(strTabelle).Cells(lngUeberschriftRow, 2), Sheets(strTabelle).Cells( _
lngUeberschriftRow, 13))
.BorderAround Weight:=xlThick
.Borders(xlInsideVertical).Weight = xlThin
.VerticalAlignment = xlCenter
.Font.Bold = True
End With
Cells(lngUeberschriftRow, 2).BorderAround Weight:=xlThick
Cells(lngUeberschriftRow, 13).BorderAround Weight:=xlThick
' Zeile Gesamtergebnis
Cells(lngLastRow, 2).BorderAround Weight:=xlThick
Cells(lngLastRow, 13).BorderAround Weight:=xlThick
Cells(lngLastRow, 2).Font.Bold = True
Cells(lngLastRow, 13).Font.Bold = True
Range(Cells(lngLastRow, 3), Cells(lngLastRow, 12)).Borders(xlEdgeBottom).LineStyle = xlNone
Range(Cells(lngLastRow, 3), Cells(lngLastRow, 12)).Borders(xlInsideVertical).LineStyle =  _
xlNone
' falls erste Spalte umranden:
Range(Cells(lngUeberschriftRow, 2), Cells(lngLastRow - 1, 2)).BorderAround Weight:=xlThick
'fetter rand
Range(Cells(lngUeberschriftRow, 2), Cells(lngLastRow - 1, 13)).BorderAround Weight:=xlThick
'Spaltenbreite optimieren
Cells(lngUeberschriftRow, 2).CurrentRegion.Columns.AutoFit
End Sub

Eigentlich ist - wenn Sheet(Strtabelle) das aktuelle Blatt ist, es nicht nötig, das immer voranzustellen. Und falls Du flexibel bleiben willst, sollten die "2" und "13" für die Spalten B
bzw. M noch durch Variablen ersetzt werden.
Gruß
Ralph

Anzeige
total cool besten dank an Ralph
27.10.2015 00:36:30
Thomas
Hallo Ralf,
das ist total cool. Bin gerade immer noch beim versuchen. Ich bin immer gescheitert.
Hab vielen vielen dank für die viele Arbeit die Du dir gemacht hast es funktioniert super.
Ich freu mich riesig.
liebe grüsse thomas

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige