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

SORT - wie sage ich hier was der Key ist?

SORT - wie sage ich hier was der Key ist?
09.04.2016 14:32:14
cH_rI_sI
Hallo,
ich brauche wie immer Eure Hilfe ;-)
Wie kann ich sagen, dass der Key beim Sortieren der Bereich

Range(Sheets("Zusammenfassung (BL2)").Cells(blockanf, 1), Sheets("Zusammenfassung (BL2)").Cells(blockend, 1))
(also Ende = 1 statt 17) vom zuvor definierten Block ist?
Beim Sortieren tut sich nämlich nichts... Ich glaube, dass liegt am fehlenden Key oder täusche ich mich?
Hier der Code:

Sub sortieren()
Dim block As Range
letzte = Sheets("Zusammenfassung (BL2)").Cells(Sheets("Zusammenfassung (BL2)").Rows.Count,  _
1).End(xlUp).Row
blockanf = 0
blockend = 0
For i = 1 To letzte
If Cells(i, 1) = "Frage:" Then
blockanf = i
If bloackanf = i Then
blockanf = blockanf
End If
End If
If Cells(i, 1) = "" Or i = letzte Then
blockend = i
If blockend = i And blockanf  0 Then
blockend = blockend
Set block = Range(Sheets("Zusammenfassung (BL2)").Cells(blockanf, 1), Sheets(" _
Zusammenfassung (BL2)").Cells(blockend, 17))
With ActiveWorkbook.Worksheets("Zusammenfassung (BL2)").Sort
.SetRange block
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
End If
Next i
End Sub
Wäre nett, wenn sich jemand das ansehen könntet - Danke!
Lg,
Chrisi

18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: SORT - wie sage ich hier was der Key ist?
09.04.2016 14:55:54
Werner
Hallo Chrisi,
1. die Variablen i - blockanf - blockend sind nicht deklariert
2. einmal Schreibfehler bloackanf
3. Codeteil
For i = 1 To letzte 'also hier ist i = 1
If Cells(i, 1) = "Frage:" Then 'wenn in A1 Frage steht dann
blockanf = i 'ist blockanf 1
If bloackanf = i Then 'wenn blockanf = 1 dann
blockanf = blockanf 'blockanf = blockanf sprich 1 = 1 ?
End If
End If
4. weiter unten mit blockend genau das gleiche
5. führe die Sortierung doch einmal händisch aus und zeichne das mit dem Macrorekorder auf. Den Code kannst du dann an deine Bedürfnisse anpassen.
Gruß Werner

Anzeige
AW: SORT - wie sage ich hier was der Key ist?
09.04.2016 17:28:48
cH_rI_sI
Hallo Werner,
sorry aber ich verstehe leider nur Bahnhof (habe noch keine VBA-Kenntnisse, Kurs erst im Herbst)...
Lg

AW: SORT - wie sage ich hier was der Key ist?
09.04.2016 17:39:19
Werner
Hallo Chrisi,
dann lade mal eine Beispielmappe mit Dummy-Daten mit Istzustand und Sollzustand hier hoch.
Gruß Werner

AW: SORT - wie sage ich hier was der Key ist?
09.04.2016 18:05:28
cH_rI_sI
Was ich vergessen habe zu erwähnen - die anderen Bereiche (Hauptabweichung und Hinweise / Verbesserungsvorschläge - siehe Zusammenfassung) können auch mit Daten befüllt sein (Abhängig von Punktezahl - siehe Fragen).
Danke.
Lg

Anzeige
AW: SORT - wie sage ich hier was der Key ist?
10.04.2016 14:39:14
Werner
Hallo,
ich habe dir mal was eingebaut. Was mir aufgefallen ist, es werden keine Daten in die Zusammenfassung übernommen die bei den Fragen mit der Wertung 10 (grün) ausgewählt wurden. Das habe ich mir aber nicht näher angesehen.

Die Datei https://www.herber.de/bbs/user/104866.xlsm wurde aus Datenschutzgründen gelöscht


Gruß Werner

AW: SORT - wie sage ich hier was der Key ist?
10.04.2016 16:37:57
cH_rI_sI
Hallo Werner,
Du bist echt der Beste!!! Funktioniert tadellos - bis auf das Formatieren (habe ich nun wieder aktiviert) - hier gibt es nun Probleme, wenn man einen Eintrag löscht und dann wieder einfügen lässt...
Wäre nett, wennst nochmal drüber schauen kannst:

Die Datei https://www.herber.de/bbs/user/104869.xlsm wurde aus Datenschutzgründen gelöscht


Besten Dank im Voraus!
Lg

Anzeige
AW: SORT - wie sage ich hier was der Key ist?
10.04.2016 16:53:53
Werner
Hallo,
lag wohl hierran:
For SP = 3 To 17
geändert in:
For SP = 1 To 17

Die Datei https://www.herber.de/bbs/user/104870.xlsm wurde aus Datenschutzgründen gelöscht


Gruß Werner

AW: SORT - wie sage ich hier was der Key ist?
10.04.2016 17:17:50
cH_rI_sI
OK - aber ich will aber nur die Breite von Spalte C bis Q ermittlen - daher 3 To 17.
Wie kann man das dann lösen?

AW: SORT - wie sage ich hier was der Key ist?
10.04.2016 17:43:42
Werner
Hallo,
hab gerade keinen Zugriff auf Excel mit Makros (Tablet). Stell noch mal nur den Code fürs Formatieren hier ein.
Gruß Werner

Anzeige
AW: SORT - wie sage ich hier was der Key ist?
10.04.2016 17:48:41
cH_rI_sI
Hallo Werner,
hier der (ganze) Code:
Sub Zusammenfassung()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim iZeile As Long, tempZeile As Long, iZähler As Long
Dim strMark As String
Set WS1 = Worksheets("Fragen (BL4)")
Set WS2 = Worksheets("Zusammenfassung (BL2)")
Application.ScreenUpdating = False
For iZeile = WS1.Cells(WS1.Rows.Count, 9).End(xlUp).Row To 9 Step -1
If IsNumeric(WS1.Cells(iZeile, 9)) And WS1.Cells(iZeile, 9)  "" And _
WorksheetFunction.CountIf(WS2.Columns(1), WS1.Cells(iZeile, 1)) = 0 And _
Left(WS1.Cells(iZeile, 1), 4)  "Punk" And _
Left(WS1.Cells(iZeile, 1), 4)  "Erfü" Then
iZähler = iZähler + 1
Select Case WS1.Cells(iZeile, 9)
'Case 10: strMark = "Positive Bemerkungen"
Case 8: strMark = "Hinweise / Verbesserungsvorschläge:"
Case 6: strMark = "Nebenabweichungen:"
Case 4: strMark = "Hauptabweichungen:"
Case 0: strMark = "Hauptabweichungen:"
Case Else: strMark = ""
End Select
If strMark  "" Then
tempZeile = Application.Match(strMark, WS2.Columns(3), 0) + 1
WS2.Rows(tempZeile).Insert Shift:=xlDown
WS2.Cells(tempZeile, 1) = WS1.Cells(iZeile, 1)
WS2.Cells(tempZeile, 3) = WS1.Cells(iZeile, 11)
Call sortieren
Call ZeileFormatieren(tempZeile, WS2)
End If
End If
Next iZeile
End Sub

Sub sortieren()
Dim anfang1 As Long
Dim ende1 As Long
Dim anfang2 As Long
Dim ende2 As Long
Dim anfang3 As Long
Dim ende3 As Long
Dim anfang4 As Long
Dim ende4 As Long
Dim block1 As Range
Dim block2 As Range
Dim block3 As Range
Dim block4 As Range
Dim bereich1 As Range
Dim test As Range
With Sheets("Zusammenfassung (BL2)")
'**** Ermittelt den Bereich block1 ****
anfang1 = .Range("A6").End(xlDown).Row
If .Cells(anfang1 + 1, 1) = "" Then
ende1 = anfang1 + 1
Else
ende1 = .Range("A" & anfang1).End(xlDown).Row
Set block1 = Sheets("Zusammenfassung (BL2)").Range("A" & anfang1 & ":Q" & ende1)
End If
'**** Ermittelt den Bereich block2 ****
anfang2 = .Range("A" & ende1).End(xlDown).Row
If .Cells(anfang2 + 1, 1) = "" Then
ende2 = anfang2 + 1
Else
ende2 = .Range("A" & anfang2).End(xlDown).Row
Set block2 = Sheets("Zusammenfassung (BL2)").Range("A" & anfang2 & ":Q" & ende2)
End If
'**** Ermittelt den Bereich block3 ****
anfang3 = .Range("A" & ende2).End(xlDown).Row
If .Cells(anfang3 + 1, 1) = "" Then
ende3 = anfang3 + 1
Else
ende3 = .Range("A" & anfang3).End(xlDown).Row
Set block3 = Sheets("Zusammenfassung (BL2)").Range("A" & anfang3 & ":Q" & ende3)
End If
'**** Ermittelt den Bereich block4 ****
anfang4 = .Range("A" & ende3).End(xlDown).Row
If .Cells(anfang4 + 1, 1) = "" Then
ende4 = anfang4 + 1
Else
ende4 = .Range("A" & anfang4).End(xlDown).Row
Set block4 = Sheets("Zusammenfassung (BL2)").Range("A" & anfang4 & ":Q" & ende4)
End If
If Not block1 Is Nothing Then
If block1.Rows.Count > 2 Then
'*** sortieren ***
Worksheets("Zusammenfassung (BL2)").Sort.SortFields.Clear
Worksheets("Zusammenfassung (BL2)").Sort.SortFields.Add _
Key:=Range("A" & anfang1 & ":A" & ende1), SortOn:=xlSortOnValues, Order:= _
xlAscending, _
CustomOrder:= _
"1.1,1.2,1.3,1.4,1.5,2.1,2.2,2.3,2.4,2.5,3.1,3.2,3.3,3.4,3.5,3.6,4.1,4.2,4.3,4.4,4. _
5,5.1,5.2,5.3,5.4,5.5,5.6,5.7,5.8,5.9,5.10,5.11,6.1,6.2,6.3,6.4,6.5,6.6,7.1,7.2,7.3,7.4,7.5,7.6,7.7,8.1,8.2,8.3,9.1,9.2,10.1,10.2,10.3,11.1,11.2" _
, DataOption:=xlSortTextAsNumbers
With Worksheets("Zusammenfassung (BL2)").Sort
.SetRange Range(block1.Address)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
End If
If Not block2 Is Nothing Then
If block2.Rows.Count > 2 Then
'*** sortieren ***
Worksheets("Zusammenfassung (BL2)").Sort.SortFields.Clear
Worksheets("Zusammenfassung (BL2)").Sort.SortFields.Add _
Key:=Range("A" & anfang2 & ":A" & ende2), SortOn:=xlSortOnValues, Order:= _
xlAscending, _
CustomOrder:= _
"1.1,1.2,1.3,1.4,1.5,2.1,2.2,2.3,2.4,2.5,3.1,3.2,3.3,3.4,3.5,3.6,4.1,4.2,4.3,4.4,4. _
5,5.1,5.2,5.3,5.4,5.5,5.6,5.7,5.8,5.9,5.10,5.11,6.1,6.2,6.3,6.4,6.5,6.6,7.1,7.2,7.3,7.4,7.5,7.6,7.7,8.1,8.2,8.3,9.1,9.2,10.1,10.2,10.3,11.1,11.2" _
, DataOption:=xlSortTextAsNumbers
With Worksheets("Zusammenfassung (BL2)").Sort
.SetRange Range(block2.Address)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
End If
If Not block3 Is Nothing Then
If block3.Rows.Count > 2 Then
'*** sortieren ***
Worksheets("Zusammenfassung (BL2)").Sort.SortFields.Clear
Worksheets("Zusammenfassung (BL2)").Sort.SortFields.Add _
Key:=Range("A" & anfang3 & ":A" & ende3), SortOn:=xlSortOnValues, Order:= _
xlAscending, _
CustomOrder:= _
"1.1,1.2,1.3,1.4,1.5,2.1,2.2,2.3,2.4,2.5,3.1,3.2,3.3,3.4,3.5,3.6,4.1,4.2,4.3,4. _
4,4.5,5.1,5.2,5.3,5.4,5.5,5.6,5.7,5.8,5.9,5.10,5.11,6.1,6.2,6.3,6.4,6.5,6.6,7.1,7.2,7.3,7.4,7.5,7.6,7.7,8.1,8.2,8.3,9.1,9.2,10.1,10.2,10.3,11.1,11.2" _
, DataOption:=xlSortTextAsNumbers
With Worksheets("Zusammenfassung (BL2)").Sort
.SetRange Range(block3.Address)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
End If
If Not block4 Is Nothing Then
If block4.Rows.Count > 2 Then
'*** sortieren ***
Worksheets("Zusammenfassung (BL2)").Sort.SortFields.Clear
Worksheets("Zusammenfassung (BL2)").Sort.SortFields.Add _
Key:=Range("A" & anfang4 & ":A" & ende4), SortOn:=xlSortOnValues, Order:= _
xlAscending, _
CustomOrder:= _
"1.1,1.2,1.3,1.4,1.5,2.1,2.2,2.3,2.4,2.5,3.1,3.2,3.3,3.4,3.5,3.6,4.1,4.2,4.3,4. _
4,4.5,5.1,5.2,5.3,5.4,5.5,5.6,5.7,5.8,5.9,5.10,5.11,6.1,6.2,6.3,6.4,6.5,6.6,7.1,7.2,7.3,7.4,7.5,7.6,7.7,8.1,8.2,8.3,9.1,9.2,10.1,10.2,10.3,11.1,11.2" _
, DataOption:=xlSortTextAsNumbers
With Worksheets("Zusammenfassung (BL2)").Sort
.SetRange Range(block4.Address)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
End If
End With
End Sub

   Private Sub ZeileFormatieren(Zeile As Long, ws As Worksheet)
'Breite der verbundenen Zellen bestimmen
Dim Breite As Long
Dim BreiteG As Long
Dim SP As Long
For SP = 1 To 17
Breite = Columns(SP).ColumnWidth
BreiteG = BreiteG + Breite
Next SP
Columns("C:C").ColumnWidth = BreiteG
ws.Range(ws.Cells(Zeile, 1), ws.Cells(Zeile, 2)).Merge
'WS.Range(WS.Cells(Zeile, 3), WS.Cells(Zeile, 17)).Merge
With ws.Range(ws.Cells(Zeile, 1), ws.Cells(Zeile, 17))
.Interior.Pattern = xlNone
.Font.Bold = False
.Font.Size = 10
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.WrapText = True
'.Rows.EntireRow.AutoFit
.Columns("C:C").ColumnWidth = BreiteG 'vorher fixer Wert von 55
.Rows.EntireRow.AutoFit
.Columns("C:C").ColumnWidth = 5
ws.Range(ws.Cells(Zeile, 3), ws.Cells(Zeile, 17)).Merge
End With
End Sub
Und danke für alles Werner!
Lg

Anzeige
AW: SORT - wie sage ich hier was der Key ist?
10.04.2016 20:52:57
Werner
Hallo,
versuch mal so:
Private Sub ZeileFormatieren(Zeile As Long, ws As Worksheet)
'Breite der verbundenen Zellen bestimmen
'wenn ich mich recht entsinne gab es nach der Erstellung der
'Zusammenfassung keine verbundenen Zellen in der Zusammenfassung
Dim Breite As Long
Dim BreiteG As Long
Dim SP As Long
Set ws = Worksheets("Zusammenfassung (BL2)") 'hier fehlte das Worksheet
For SP = 3 To 17
Breite = ws.Columns(SP).ColumnWidth
'es wird die Gesamtbreite der Spalten C bis Q ermittelt
BreiteG = BreiteG + Breite
Next SP
'der Spalte C wird die oben ermittelte Gesamtbreite zugewiesen
ws.Columns("C:C").ColumnWidth = BreiteG
'der Variablen Zeile wird nirgendwo ein Wert zugewiesen
With ws.Range(ws.Cells(Zeile, 1), ws.Cells(Zeile, 17))
.Interior.Pattern = xlNone
.Font.Bold = False
.Font.Size = 10
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.WrapText = True
'.Rows.EntireRow.AutoFit
'hier wird der Spalte C erneut die Gesamtbreite von C bis Q zugewiesen ?
.Columns("C:C").ColumnWidth = BreiteG 'vorher fixer Wert von 55
.Rows.EntireRow.AutoFit
'jetzt wird der Spalte C die Breite 5 zugewiesen ?
.Columns("C:C").ColumnWidth = 5
End With
ws.Range(ws.Cells(Zeile, 1), ws.Cells(Zeile, 2)).Merge
ws.Range(ws.Cells(Zeile, 3), ws.Cells(Zeile, 17)).Merge
End Sub
Könnte daran liegen, dass A und B schon verbunden sind, bevor dann der Rest der Formatierung drüber läuft.
Verbundene Zellen sind in Sachen VBA problematisch und kompliziert.
Zudem fehlte die Zuweisung (Set WS =...) zum entsprechenden Tabellenblatt.
Einiges an deinem Code ist mir ziemlich schleierhaft. Ich hab dir ein paar Bemerkungen in den Code geschrieben.
Ich bin in Sachen VBA gerade mal über das Anfangsstadium raus vielleicht verstehe ich es deshalb auch nicht.
Was du wohl machen willst ist: Von A bis Q: Kein Muster, Schriftgröße 10, keine Fettschrift, Rahmen um den Bereich A bis Q, Zellen A und B sowie C bis Q verbinden. Was die Zuweisung der Spaltenbreite der Spalte C betrifft, da steige ich allerdings nicht durch was du da willst.
Wenn es nicht klappt dann solltest du mal beschreiben was du vor hast.
Gruß Werner

Anzeige
AW: SORT - wie sage ich hier was der Key ist?
10.04.2016 17:48:56
cH_rI_sI
Hallo Werner,
hier der (ganze) Code:
Sub Zusammenfassung()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim iZeile As Long, tempZeile As Long, iZähler As Long
Dim strMark As String
Set WS1 = Worksheets("Fragen (BL4)")
Set WS2 = Worksheets("Zusammenfassung (BL2)")
Application.ScreenUpdating = False
For iZeile = WS1.Cells(WS1.Rows.Count, 9).End(xlUp).Row To 9 Step -1
If IsNumeric(WS1.Cells(iZeile, 9)) And WS1.Cells(iZeile, 9)  "" And _
WorksheetFunction.CountIf(WS2.Columns(1), WS1.Cells(iZeile, 1)) = 0 And _
Left(WS1.Cells(iZeile, 1), 4)  "Punk" And _
Left(WS1.Cells(iZeile, 1), 4)  "Erfü" Then
iZähler = iZähler + 1
Select Case WS1.Cells(iZeile, 9)
'Case 10: strMark = "Positive Bemerkungen"
Case 8: strMark = "Hinweise / Verbesserungsvorschläge:"
Case 6: strMark = "Nebenabweichungen:"
Case 4: strMark = "Hauptabweichungen:"
Case 0: strMark = "Hauptabweichungen:"
Case Else: strMark = ""
End Select
If strMark  "" Then
tempZeile = Application.Match(strMark, WS2.Columns(3), 0) + 1
WS2.Rows(tempZeile).Insert Shift:=xlDown
WS2.Cells(tempZeile, 1) = WS1.Cells(iZeile, 1)
WS2.Cells(tempZeile, 3) = WS1.Cells(iZeile, 11)
Call sortieren
Call ZeileFormatieren(tempZeile, WS2)
End If
End If
Next iZeile
End Sub

Sub sortieren()
Dim anfang1 As Long
Dim ende1 As Long
Dim anfang2 As Long
Dim ende2 As Long
Dim anfang3 As Long
Dim ende3 As Long
Dim anfang4 As Long
Dim ende4 As Long
Dim block1 As Range
Dim block2 As Range
Dim block3 As Range
Dim block4 As Range
Dim bereich1 As Range
Dim test As Range
With Sheets("Zusammenfassung (BL2)")
'**** Ermittelt den Bereich block1 ****
anfang1 = .Range("A6").End(xlDown).Row
If .Cells(anfang1 + 1, 1) = "" Then
ende1 = anfang1 + 1
Else
ende1 = .Range("A" & anfang1).End(xlDown).Row
Set block1 = Sheets("Zusammenfassung (BL2)").Range("A" & anfang1 & ":Q" & ende1)
End If
'**** Ermittelt den Bereich block2 ****
anfang2 = .Range("A" & ende1).End(xlDown).Row
If .Cells(anfang2 + 1, 1) = "" Then
ende2 = anfang2 + 1
Else
ende2 = .Range("A" & anfang2).End(xlDown).Row
Set block2 = Sheets("Zusammenfassung (BL2)").Range("A" & anfang2 & ":Q" & ende2)
End If
'**** Ermittelt den Bereich block3 ****
anfang3 = .Range("A" & ende2).End(xlDown).Row
If .Cells(anfang3 + 1, 1) = "" Then
ende3 = anfang3 + 1
Else
ende3 = .Range("A" & anfang3).End(xlDown).Row
Set block3 = Sheets("Zusammenfassung (BL2)").Range("A" & anfang3 & ":Q" & ende3)
End If
'**** Ermittelt den Bereich block4 ****
anfang4 = .Range("A" & ende3).End(xlDown).Row
If .Cells(anfang4 + 1, 1) = "" Then
ende4 = anfang4 + 1
Else
ende4 = .Range("A" & anfang4).End(xlDown).Row
Set block4 = Sheets("Zusammenfassung (BL2)").Range("A" & anfang4 & ":Q" & ende4)
End If
If Not block1 Is Nothing Then
If block1.Rows.Count > 2 Then
'*** sortieren ***
Worksheets("Zusammenfassung (BL2)").Sort.SortFields.Clear
Worksheets("Zusammenfassung (BL2)").Sort.SortFields.Add _
Key:=Range("A" & anfang1 & ":A" & ende1), SortOn:=xlSortOnValues, Order:= _
xlAscending, _
CustomOrder:= _
"1.1,1.2,1.3,1.4,1.5,2.1,2.2,2.3,2.4,2.5,3.1,3.2,3.3,3.4,3.5,3.6,4.1,4.2,4.3,4.4,4. _
5,5.1,5.2,5.3,5.4,5.5,5.6,5.7,5.8,5.9,5.10,5.11,6.1,6.2,6.3,6.4,6.5,6.6,7.1,7.2,7.3,7.4,7.5,7.6,7.7,8.1,8.2,8.3,9.1,9.2,10.1,10.2,10.3,11.1,11.2" _
, DataOption:=xlSortTextAsNumbers
With Worksheets("Zusammenfassung (BL2)").Sort
.SetRange Range(block1.Address)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
End If
If Not block2 Is Nothing Then
If block2.Rows.Count > 2 Then
'*** sortieren ***
Worksheets("Zusammenfassung (BL2)").Sort.SortFields.Clear
Worksheets("Zusammenfassung (BL2)").Sort.SortFields.Add _
Key:=Range("A" & anfang2 & ":A" & ende2), SortOn:=xlSortOnValues, Order:= _
xlAscending, _
CustomOrder:= _
"1.1,1.2,1.3,1.4,1.5,2.1,2.2,2.3,2.4,2.5,3.1,3.2,3.3,3.4,3.5,3.6,4.1,4.2,4.3,4.4,4. _
5,5.1,5.2,5.3,5.4,5.5,5.6,5.7,5.8,5.9,5.10,5.11,6.1,6.2,6.3,6.4,6.5,6.6,7.1,7.2,7.3,7.4,7.5,7.6,7.7,8.1,8.2,8.3,9.1,9.2,10.1,10.2,10.3,11.1,11.2" _
, DataOption:=xlSortTextAsNumbers
With Worksheets("Zusammenfassung (BL2)").Sort
.SetRange Range(block2.Address)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
End If
If Not block3 Is Nothing Then
If block3.Rows.Count > 2 Then
'*** sortieren ***
Worksheets("Zusammenfassung (BL2)").Sort.SortFields.Clear
Worksheets("Zusammenfassung (BL2)").Sort.SortFields.Add _
Key:=Range("A" & anfang3 & ":A" & ende3), SortOn:=xlSortOnValues, Order:= _
xlAscending, _
CustomOrder:= _
"1.1,1.2,1.3,1.4,1.5,2.1,2.2,2.3,2.4,2.5,3.1,3.2,3.3,3.4,3.5,3.6,4.1,4.2,4.3,4. _
4,4.5,5.1,5.2,5.3,5.4,5.5,5.6,5.7,5.8,5.9,5.10,5.11,6.1,6.2,6.3,6.4,6.5,6.6,7.1,7.2,7.3,7.4,7.5,7.6,7.7,8.1,8.2,8.3,9.1,9.2,10.1,10.2,10.3,11.1,11.2" _
, DataOption:=xlSortTextAsNumbers
With Worksheets("Zusammenfassung (BL2)").Sort
.SetRange Range(block3.Address)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
End If
If Not block4 Is Nothing Then
If block4.Rows.Count > 2 Then
'*** sortieren ***
Worksheets("Zusammenfassung (BL2)").Sort.SortFields.Clear
Worksheets("Zusammenfassung (BL2)").Sort.SortFields.Add _
Key:=Range("A" & anfang4 & ":A" & ende4), SortOn:=xlSortOnValues, Order:= _
xlAscending, _
CustomOrder:= _
"1.1,1.2,1.3,1.4,1.5,2.1,2.2,2.3,2.4,2.5,3.1,3.2,3.3,3.4,3.5,3.6,4.1,4.2,4.3,4. _
4,4.5,5.1,5.2,5.3,5.4,5.5,5.6,5.7,5.8,5.9,5.10,5.11,6.1,6.2,6.3,6.4,6.5,6.6,7.1,7.2,7.3,7.4,7.5,7.6,7.7,8.1,8.2,8.3,9.1,9.2,10.1,10.2,10.3,11.1,11.2" _
, DataOption:=xlSortTextAsNumbers
With Worksheets("Zusammenfassung (BL2)").Sort
.SetRange Range(block4.Address)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
End If
End With
End Sub

   Private Sub ZeileFormatieren(Zeile As Long, ws As Worksheet)
'Breite der verbundenen Zellen bestimmen
Dim Breite As Long
Dim BreiteG As Long
Dim SP As Long
For SP = 1 To 17
Breite = Columns(SP).ColumnWidth
BreiteG = BreiteG + Breite
Next SP
Columns("C:C").ColumnWidth = BreiteG
ws.Range(ws.Cells(Zeile, 1), ws.Cells(Zeile, 2)).Merge
'WS.Range(WS.Cells(Zeile, 3), WS.Cells(Zeile, 17)).Merge
With ws.Range(ws.Cells(Zeile, 1), ws.Cells(Zeile, 17))
.Interior.Pattern = xlNone
.Font.Bold = False
.Font.Size = 10
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.WrapText = True
'.Rows.EntireRow.AutoFit
.Columns("C:C").ColumnWidth = BreiteG 'vorher fixer Wert von 55
.Rows.EntireRow.AutoFit
.Columns("C:C").ColumnWidth = 5
ws.Range(ws.Cells(Zeile, 3), ws.Cells(Zeile, 17)).Merge
End With
End Sub
Und danke für alles Werner!
Lg

Anzeige
AW: SORT - wie sage ich hier was der Key ist?
11.04.2016 06:48:53
Christian
Guten Morgen Werner,
würde mich freuen, wenn Du Dir die Formatierung nochmal ansehen kannst - Danke.
Hier nur der Code von der Zusammenfassung:
   Private Sub ZeileFormatieren(Zeile As Long, ws As Worksheet)
'Breite der verbundenen Zellen bestimmen
Dim Breite As Long
Dim BreiteG As Long
Dim SP As Long
For SP = 1 To 17
Breite = Columns(SP).ColumnWidth
BreiteG = BreiteG + Breite
Next SP
Columns("C:C").ColumnWidth = BreiteG
ws.Range(ws.Cells(Zeile, 1), ws.Cells(Zeile, 2)).Merge
'WS.Range(WS.Cells(Zeile, 3), WS.Cells(Zeile, 17)).Merge
With ws.Range(ws.Cells(Zeile, 1), ws.Cells(Zeile, 17))
.Interior.Pattern = xlNone
.Font.Bold = False
.Font.Size = 10
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.WrapText = True
'.Rows.EntireRow.AutoFit
.Columns("C:C").ColumnWidth = BreiteG 'vorher fixer Wert von 55
.Rows.EntireRow.AutoFit
.Columns("C:C").ColumnWidth = 5
ws.Range(ws.Cells(Zeile, 3), ws.Cells(Zeile, 17)).Merge
End With
End Sub
Wünsche Dir einen schönen Tag!
Lg,
Chrisi

Anzeige
AW: SORT - wie sage ich hier was der Key ist?
11.04.2016 10:49:23
Christian
Hallo Werner,
ich habe leider übersehen, dass Du Dich eh gestern Abend noch gemeldet hast - besten Dank dafür!
Leider funktioniert das Ganze noch nicht - daher möchte ich kurz erklären, warum das Formatieren so ist wie es ist:
Also zu Beginn muss ich die Gesamtbreite der verbundenen Spalten (C:Q) ermitteln, weil ich diese dann an der jeweiligen Zelle in Spalte C anwende und erst dann den Zeilenumbruch einstelle - somit passt dann der Text genau zur Breite des Spaltenverbunds und auch die autom. Zeilenhöhe passt dann. Und sobald die autom. Zeilenhöhe passt kann man die Zellen verbinden - ansonsten hätte man große Probleme beim Einstellen der autom. Zeilenhöhe, weil diese bei verbundenen Zellen nicht klappt...
Ich denke das Problem liegt jetzt daran, weil es schon verbundene Zellen gibt...
Daher hätte ich nach Ermittlung des jeweiligen Bereichs zuerst ein "Unmerge" gemacht, damit vorhandene, verbundene Zellen wieder getrennt werden. Aber leider wird dann die Formatierung nur für die erste Zeile des Bereichs gemacht und darunter nicht mehr...
Anbei nochmals das File - wäre nett, wenn sich das jemand ansehen könntet:
https://www.herber.de/bbs/user/104887.xlsm
Danke!!!
Glg,
Chrisi

Anzeige
AW: SORT - wie sage ich hier was der Key ist?
11.04.2016 12:17:14
Christian
Hey Werner,
ich bin sprachlos - es passt!!! Mich wundert zwar, dass das Sortieren nach dem Formatieren überhaupt funktioniert, da ja dann Zellen verbunden sind...
Nochmals besten Dank für die echt professionelle Unterstützung!!!
Glg,
Chrisi

AW: Gerne u. Danke für die Rückmeldung. o.w.T.
11.04.2016 12:18:57
Werner

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige