Es hat geklappt :) -Das Endresultat
14.11.2017 19:45:29
Markus
Hallo
@Daniel: Danke für deine Erklärung, jetzt verstehe ich endlich warum jeder Versuch in die Hosen gegangen ist denn selbst wenn der rang keinen Fehler Produzierte. Wurde er dennoch falsch also als ein Bereich eingetragen.
With Range("A3:A" & x & ",E3:M" & x)
ist ein toller Tipp und er Funktioniert auch bestens.
@ Fennek die Code Zeile funktioniert ebenfalls, danke für die ganze Hilfe und für das Bsp. Erst darauf konnte ich erst überhaupt aufbauen.
with union(Range("A3:A20"),range(Cells(x,5), cells(x,13)))
Das ist der derzeitige Code, er Funktioniert falls ihr noch irgendwelche Anmerkungen oder Verbesserungsvorschläge habt dann würde ich mich darüber freuen. In jedem Fall Vielen Danke nochmal an alle die Mitgewirkt haben. Ich habe hierbei echt was gelernt.
Sub Sortieren_und_Bedi_Formatieren()
Dim x As Long
Dim Formula1 As Variant
x = LezteZ(Sheets("Tabelle1")) ' Funktion ermittelt die Letzte beschriebenen Zeile
With ThisWorkbook.Worksheets("Tabelle1").Sort
.SortFields.Clear
.SortFields.Add Key:=Range(Cells(5, 7), Cells(x, 7)), SortOn:=xlSortOnValues, Order: _
=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=Range(Cells(5, 5), Cells(x, 5)), SortOn:=xlSortOnValues, Order: _
=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=Range(Cells(5, 6), Cells(x, 6)), SortOn:=xlSortOnValues, Order: _
=xlAscending, DataOption:=xlSortNormal
'.SortFields.Add Key:=Range(Cells(5, 1), Cells(x, 1)), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range(Cells(2, 1), Cells(x, 17))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
x = x + 15 'Letzte Zeil des zu formatierenden bereiches
Sheets("Tabelle1").Cells.FormatConditions.Delete 'bereits vorhandene Formatierungen Löschen
With Range("A3:A" & x & ",E3:M" & x) ' Angabe des zu Formatierenden Bereiches
.FormatConditions.Add Type:=xlExpression, Formula1:="=ODER($A3=""HRH"";$A3=""TWT"")" _
With .FormatConditions(1)
.Interior.PatternColorIndex = xlAutomatic
.Interior.Color = RGB(255, 255, 0)
.Interior.TintAndShade = 0
.Font.Color = RGB(255, 0, 0) 'Schrift Farbe
End With
.FormatConditions.Add Type:=xlExpression, Formula1:="=ODER($A3=""2g"";$A3=""2t"";$ _
A3=2)"
With .FormatConditions(2)
.Interior.PatternColorIndex = xlAutomatic
.Interior.Color = RGB(217, 217, 217)
.Interior.TintAndShade = 0
End With
.FormatConditions.Add Type:=xlExpression, Formula1:="=UND($A3=1;$B3=40)"
With .FormatConditions(3)
.Interior.PatternColorIndex = xlAutomatic
.Interior.Color = RGB(255, 255, 255) '
.Interior.TintAndShade = 0
.Font.Color = RGB(255, 0, 0) 'Schriftfarbe
End With
.FormatConditions.Add Type:=xlExpression, Formula1:="=$A3=1"
With .FormatConditions(4)
.Interior.PatternColorIndex = xlAutomatic
.Interior.Color = RGB(255, 255, 255)
.Interior.TintAndShade = 0
End With
.FormatConditions.Add Type:=xlExpression, Formula1:="=$A3=3"
With .FormatConditions(5)
.Interior.PatternColorIndex = xlAutomatic
.Interior.Color = RGB(255, 102, 153)
.Interior.TintAndShade = 0
End With
' usw.
End With
Range("A1").Select
End Sub
Function LezteZ(wks As Worksheet) As Long
'Zählt die Anzahl der benutzten Zeilen und gibt sie aus.
'Es werden alle Zeilen berücksichtigt ebenfalls ausgeblendeten.
'Es werden die Zeilen die zbs. durch Filtern ausgeblendet wurden berücksichtigt.
Dim lngFirst As Long, lngLast As Long, lngTmp As Long
With Application
If .CountA(wks.Cells) = 0 Then Exit Function
If .CountA(wks.Rows(wks.Rows.Count)) Then
LezteZ = wks.Rows.Count: Exit Function
End If
lngLast = wks.Rows.Count
Do While lngLast > lngFirst + 1
lngTmp = (lngFirst + lngLast) \ 2
If .CountA(wks.Rows(lngTmp).Resize(lngLast - lngTmp)) Then _
lngFirst = lngTmp Else lngLast = lngTmp
Loop
If .CountA(wks.Rows(lngLast)) Then LezteZ = lngLast Else LezteZ = lngFirst
End With
End Function
Grüße Markus