Tabelle formatieren

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Tabelle formatieren
von: Thomas
Geschrieben am: 26.10.2015 21:16:37

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

Bild

Betrifft: AW: Tabelle formatieren
von: Esmo
Geschrieben am: 27.10.2015 00:16:29
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

Bild

Betrifft: total cool besten dank an Ralph
von: Thomas
Geschrieben am: 27.10.2015 00:36:30
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

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Tabelle formatieren"