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

Sortieren je Bereich

Sortieren je Bereich
06.04.2016 13:21:26
Christian
Hallo,
ich würde gerne u.a. Coding optimieren, indem die jeweiligen Bereiche "Hauptabweichung", "Nebenabweichung" und "Hinweise / Verbesserungsvorschläge" getrennt voneinander immer nach Spalte A sortiert werden - hier ist weiters zu beachten, dass das Format der zu sortierenden Nummern wie folgt aussieht:
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
Wenn ich nämlich eine Zeile lösche, dann wird beim erneuten Aufruf des Makros "Zusammenfassung" der fehlende Eintrag im entsprechenden Bereich immer ganz oben eingefügt - siehe Bild:
Userbild
Anbei das Coding:
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 ZeileFormatieren(tempZeile, WS2)
End If
End If
Next iZeile
End Sub
Private Sub ZeileFormatieren(Zeile As Long, WS As Worksheet)
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 = 55
.Rows.EntireRow.AutoFit
.Columns("C:C").ColumnWidth = 5
WS.Range(WS.Cells(Zeile, 3), WS.Cells(Zeile, 17)).Merge
End With
End Sub

So - ich hoffe Ihr versteht was ich gerne machen möchte ;-)
Besten Dank im Voraus für Eure professionelle Unterstützung!!!
Lg,
Chrisi

19
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Sortieren je Bereich
06.04.2016 16:42:54
selli
hallo christian,
auf das gepostete bild ist das makro nicht anwendbar.
gruß
selli

AW: Sortieren je Bereich
06.04.2016 17:34:57
cH_rI_sI
Hi Selli,
das bestehende Coding funktioniert einwandfrei bis auf das Sortieren - wie kann man dann so etwas lösen? Hast eine Idee?
Lg

AW: Sortieren je Bereich
07.04.2016 12:56:49
selli
hallo christian,
bilder schneiden und dann wieder zusammenfügen sollte mit inkscape ganz gut gehen.
ob es dafür aber codes gibt kann ich nicht sagen. wäre dann auch das falsche forum.
gruß
selli

AW: Sortieren je Bereich
07.04.2016 13:18:10
Christian
Hi Selli,
entweder ich verstehe jetzt nicht was Du mir sagen möchtest oder Du hast u.U. die Problemstellung nicht ganz verstanden.
Das Problem hat nichts mit einem Bild zu tun - das Bild ist nur ein Screenshot von dem Tabellenblatt "Zusammenfassung".

Anzeige
AW: Sortieren je Bereich
07.04.2016 13:33:47
selli
hallo christian,
in dem fall empfiehlt es sich vor erstelleng des screenshot zu sortieren.
gruß
selli

AW: Sortieren je Bereich
07.04.2016 13:53:07
Steve
Hallo Christian,
was Selli dir damit sagen will: Stelle doch bitte eine Testdatei ein, denn wir (nicht nur Selli) haben keine Lust und Zeit deine Mappe komplett nachzubauen. Daher der sarkastische Kommentar mit der Bildbearbeitung...
Zudem birgt eine nachgebastelte Mappe immer das Risiko dass eine Menge Nacharbeit am Makro entsteht, weil die Struktur deiner Mappe dann anders aussieht, Formatierungen Probleme machen oder man selbst beim Erstellen zu viele Annahmen getroffen hat. Das alles kostet wahnsinnig Zeit und Nerven, aber entfällt wenn du nicht so geizt.
lg Steve

Anzeige
@steve
07.04.2016 14:36:50
selli
hallo steve,
bisher dachte ich immer, dass ich mich ziemlich eindeutig ausdrücke und habe auch niemanden gebraucht, der anderen sagt wie ich was meine. vielen dank dafür.
übrigens war der hinweis auf inkscape keineswegs sarkastisch gemeint. ist ein tolles programm. freeware und open source.
gruß
selli

AW: @steve
07.04.2016 14:51:27
Steve
Hallo Selli,
es gibt immer ein erstes Mal, mMn war der Zaunspfahl auch mehr als groß genug, scheinbar mögen manche Menschen keine Zäune. Ich musste das ganze jedoch auflösen um meine Lachmuskeln zu schonen.
Inkscape habe ich auch nie angezweifelt ;)
lg Steve

Anzeige
AW: @steve
08.04.2016 07:32:05
selli
hallo christian,
also deine beispieltabelle ist ohne, die im bild zu sehenden daten ausgestattet.
das ist der punkt an dem ich aussteige.
gruß
selli

AW: @steve
08.04.2016 07:46:15
Christian
Hi Selli,
sorry - habe die Datei ohne Werte hochgeladen - anbei mit Beispielwerten:
https://www.herber.de/bbs/user/104837.xlsm
Vielleicht hast ja noch Lust und schaust Dir das nochmal an - Danke.
Glg,
Chrisi

Anzeige
AW: @steve
08.04.2016 10:35:52
selli
hallo christian,
diesen code mit call sortieren aufrufen bevor Call ZeileFormatieren(tempZeile, WS2) aufgerufen wird.
(weil das mit den verbundenen zellen sonst nicht geht.)
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
End If
If Cells(i, 1) = "" Or i = letzte Then
blockend = i
Set block = Range(Sheets("Zusammenfassung (BL2)").Cells(i, 1), Sheets("Zusammenfassung (BL2)"). _
Cells(i, 17))
With ActiveWorkbook.Worksheets("Zusammenfassung (BL2)").Sort
.SetRange block
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
Next i
End Sub

gruß
selli

Anzeige
AW: @steve
08.04.2016 11:05:04
Christian
Hi Selli,
besten Dank für deine Mühe, aber es funktioniert leider nicht - siehe File:
https://www.herber.de/bbs/user/104842.xlsm
Verzeih mir, dass ich selbst keine Idee habe, aber mein VBA-Kurs ist erst im Herbst ;-(
Glg,
Chrisi

AW: @steve
08.04.2016 11:09:17
selli
hallo christian,
ehe du "Zusammenfassung erzeugen" startest darf es keine verbundenen zellen geben.
formatieren immer zum schluss.
gruß
selli

AW: @steve
08.04.2016 11:20:36
Christian
Hi Selli,
ich hätte jetzt vor dem Sortieren ein UnMerge gemacht:
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 UnMerge(tempZeile, WS2)
Call Sortieren
Call ZeileFormatieren(tempZeile, WS2)
End If
End If
Next iZeile
End Sub
Sub UnMerge(Zeile As Long, WS As Worksheet)
WS.Range(WS.Cells(Zeile, 1), WS.Cells(Zeile, 2)).UnMerge
WS.Range(WS.Cells(Zeile, 3), WS.Cells(Zeile, 17)).UnMerge
End Sub
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
End If
If Cells(i, 1) = "" Or i = letzte Then
blockend = i
Set block = Range(Sheets("Zusammenfassung (BL2)").Cells(i, 1), Sheets("Zusammenfassung (BL2)").  _
_
Cells(i, 17))
With ActiveWorkbook.Worksheets("Zusammenfassung (BL2)").Sort
.SetRange block
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
Next i
End Sub
Funktioniert aber leider nicht... Was mache ich falsch? Hast einen Tipp für mich?
Lg

Anzeige
AW: @steve
08.04.2016 15:58:51
cH_rI_sI
OK - verstanden, aber selbst wenn keine Zellen verbunden sind funktioniert die Sortierung leider nicht (neue / fehlende Einträge werden nach wie vor ganz oben eingereiht)...
Ich habe leider keine Idee mehr...
Lg,
Chrisi

AW: @steve
09.04.2016 08:39:23
cH_rI_sI
Guten Morgen,
ich habe nun folgendes Problem festgestellt - beim Debuggen wird mir z.B. bei blockanf der Wert 11 und für blockend der Wert 17 angezeigt - wenn aber der Block festgelegt wird, dann wird bei beiden "i" der selbe Wert (=17) ausgegeben - daher funktioniert das Sortieren nicht:
Userbild
Wie kann ich blockanf und blockend zur Blockerstellung sauber übergeben?
Hier nochmal das File:
https://www.herber.de/bbs/user/104857.xlsm
Bitte um Unterstützung - Danke!
Lg,
Chrisi

Anzeige
AW: @steve
10.04.2016 16:40:02
cH_rI_sI
Thema wird nun in einem anderen Thread (SORT - wie sage ich hier was der Key ist?) fortgesetzt - daher closed.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige