Hallo Thomas,dank Deinem Hinweis mit

Karlheinz_Feller · 12. November 2019 um 10:30

… ListObjects1 bin ich nun ein ganzes Stück weiter gekommen. das Modul sieht nun so aus:
Sub Output
Dim TABELL As String, BU As String, SK As String, LIST As String, KS As String
Dim SP As Integer
Dim WERT As Double
Dim WK1 As Worksheet
Dim ZAE As Long, LETZTE As Long, ZANZ As Long, i As Long
TABELL = InputBoxEingabe Output-Tabelle ’ Ausgabedatei eingaben
’ Ausgabedatei eingaben
BU = InputBoxEingabe Report-BU ’ Report BU
Set WK1 = WorksheetsTABELL
WK1.Select
Selection.AutoFilter

WK1.Cells2, 1.Activate

Application.ScreenUpdating = False
KS = N1 'KSt Spalte
ZAE = 2
Select Case BU
Case Is = 4-132
SP = 2
Case Is = 4-134
SP = 3
Case Is = 4-138
SP = 4
Case Is = 4-139
SP = 5
Case Is = 5-053
SP = 6
Case Is = 5-054
SP = 7
Case Is = 5-055
SP = 8
End Select

Select Case SP
Case Is = 2
SK = B1
Case Is = 3
SK = C1
Case Is = 4
SK = D1
Case Is = 5
SK = E1
Case Is = 6
SK = F1
Case Is = 7
SK = G1
Case Is = 8
SK = H1
End Select

WorksheetsTABELL.ListObjectsTABELL.Sort.SortFields. _
Add _
xlAscending,

With ActiveWorkbook.WorksheetsTABELL.ListObjects1.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'****
ZAE = 2
Debug.Print ZANZ

Do Until WK1.CellsZAE, SP =
ZAE = ZAE + 1
Loop

ZANZ = ZAE
Do Until IsEmptyWK1.CellsZANZ, 1
ZANZ = ZANZ + 1
Loop

WK1.CellsZAE, 1.Activate

For i = ZAE To ZANZ
ActiveCell.EntireRow.Delete
Next i
ZANZ = ZAE - 1

ZAE = 2

WK1.CellsZAE, 1.Select
For ZAE = 2 To ZANZ
WERT = FormatWK1.CellsZAE, SP.Value, ##,##0
WK1.CellsZAE, SP.Value = WERT
WK1.CellsZAE, SP.Font.Bold = True
WK1.CellsZAE, SP.Font.Size = 12
WEITER:
Next ZAE
WK1.CellsZAE, 1.Activate

WorksheetsTABELL.Columns.NumberFormat = #,##0
WorksheetsTABELL.ListObjectsTABELL.Sort.SortFields. _
Add _
xlAscending,

With ActiveWorkbook.WorksheetsTABELL.ListObjects1.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.ScreenUpdating = True
End Sub
Der erste Sort funktioniert nun einwandfrei, leider der zweite nichtwobei ich den ersten nur im Key abgewandelt habe.
Schwierigkeiten habe ich auch im Löschen der überflüssigen Zeilen. Die Funktionaliät passt aber das kann man sicher eleganter und schneller lösendauert teilweise 2 Min. Stelle mir das mit Markierung des Blocks Cells ZAE bis ZANZBeginn bis Ende der überflüssigen Zeilen und diesen Block löschen. Leider schaffe ich es nicht, diesen Block zu bilden. Fehlermessage: Typen unverträglich
2. Problem ist wie gesagt der 2. Sort, hier kommt keine Fehlermeldung, aber er sortiert nicht. Dieser Sort soll die abschließende Ordnung herstellen.
Hast Du eine Idee, wie das zu lösen ist ? Bin für jeden Hinweis dankbar.
Schönes Wochenende
Karlheinz

Reinhard_fb8cb7 · 12. November 2019 um 10:30

Im Code fehlen Klammern, Anführungszeichen?
Hallo Karlheinz,

zeig mal bitte den richtigen Code.

Gruß
Reinhard

Karlheinz_Feller · 12. November 2019 um 10:30

Hallo Reinhard,
danke für Deine Antwort.
Habe gerade gesehen, dass der Text-Editor hier einiges unterschlagen hat, stelle ihn deshalb nachfolgend nochmals rein:
'*******************************************
Sub Output()
Dim TABELL As String, BU As String, SK As String, LIST As String, KS As String
Dim SP As Integer
Dim WERT As Double
Dim WK1 As Worksheet
Dim ZAE As Long, LETZTE As Long, ZANZ As Long, i As Long
TABELL = InputBox(„Eingabe Output-Tabelle“) ’ Ausgabedatei eingaben
’ Ausgabedatei eingaben
BU = InputBox(„Eingabe Report-BU“) ’ Report BU
Set WK1 = Worksheets(TABELL)
WK1.Select
Selection.AutoFilter

WK1.Cells(2, 1).Activate

Application.ScreenUpdating = False
KS = „N1“ 'KSt Spalte"
ZAE = 2
Select Case BU
Case Is = „4-132“
SP = 2
Case Is = „4-134“
SP = 3
Case Is = „4-138“
SP = 4
Case Is = „4-139“
SP = 5
Case Is = „5-053“
SP = 6
Case Is = „5-054“
SP = 7
Case Is = „5-055“
SP = 8
End Select

Select Case SP
Case Is = 2
SK = „B1“
Case Is = 3
SK = „C1“
Case Is = 4
SK = „D1“
Case Is = 5
SK = „E1“
Case Is = 6
SK = „F1“
Case Is = 7
SK = „G1“
Case Is = 8
SK = „H1“
End Select
'***dieser Sort funktionert:
Worksheets(TABELL).ListObjects(TABELL).Sort.SortFields. _
Add Key:=Range(SK), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal

With ActiveWorkbook.Worksheets(TABELL).ListObjects(1).Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'****
ZAE = 2
Debug.Print ZANZ

Do Until WK1.Cells(ZAE, SP) = „“
ZAE = ZAE + 1
Loop

ZANZ = ZAE
Do Until IsEmpty(WK1.Cells(ZANZ, 1))
ZANZ = ZANZ + 1
Loop

WK1.Cells(ZAE, 1).Activate
'***schlechter Block, würde ich gerne ersetzen mit
Range(Cells mit anschließender Blocklöschung, leider nicht so einfach, wie ich dachte
For i = ZAE To ZANZ
ActiveCell.EntireRow.Delete
Next i
'**********
ZANZ = ZAE - 1

ZAE = 2

WK1.Cells(ZAE, 1).Select
For ZAE = 2 To ZANZ
WERT = Format(WK1.Cells(ZAE, SP).Value, „##,##0“)
WK1.Cells(ZAE, SP).Value = WERT
WK1.Cells(ZAE, SP).Font.Bold = True
WK1.Cells(ZAE, SP).Font.Size = 12
Next ZAE
WK1.Cells(ZAE, 1).Activate

Worksheets(TABELL).Columns().NumberFormat = „#,##0“

'***Dieser Sort funktioniert nicht:
Worksheets(TABELL).ListObjects(TABELL).Sort.SortFields. _
Add Key:=Range(KS), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal

With ActiveWorkbook.Worksheets(TABELL).ListObjects(1).Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'*****
Application.ScreenUpdating = True
End Sub
'****************************************************************
Habe meine Problemstellen im Code gekennzeichnet. Vielleicht fällt Dir ja was ein, was mir weiterhilft. Ausgangspunkt(in der auch der Startbutton verankert ist, ist 1 Pivottabelle, von der aus Detaillisten erstellt werden, leider schlecht formatiert und Leer- bzw. überflüssige Zeilen entfernt werden sollen ebenso die Formatierung der Zahlenspalten.
Würde mich freuen, wenn Dir was einfällt, was mir weiter hilft.
Danke jedenfalls für das Anwerfen Deiner graune Zellen.
viele Grüße
Karlheinz

Reinhard_fb8cb7 · 12. November 2019 um 10:46

Habe meine Problemstellen im Code gekennzeichnet. Vielleicht
fällt Dir ja was ein, was mir weiterhilft. Ausgangspunkt(in
der auch der Startbutton verankert ist, ist 1 Pivottabelle,
von der aus Detaillisten erstellt werden, leider schlecht
formatiert und Leer- bzw. überflüssige Zeilen entfernt werden
sollen ebenso die Formatierung der Zahlenspalten.
Würde mich freuen, wenn Dir was einfällt, was mir weiter
hilft.

Hallo Karlheinz,

ich sehe im Code nichts was auf Pivot hinweist aber ich sehe im Code viele Verbesserungsmöglichkeiten.

Meinst du mit „schlechter Block“ den nachfolgenden oder mehr Codezeilen?

WK1.Cells(ZAE, 1).Activate
'\*\*\*schlechter Block, würde ich gerne ersetzen mit
Range(Cells mit anschließender Blocklöschung, leider nicht so einfach, wie ich dachte
For i = ZAE To ZANZ
 ActiveCell.EntireRow.Delete
Next i
'\*\*\*\*\*\*\*\*\*\*

Das kann man z.B. so schreiben: (Kleingeschriebener Code=ungetestet!)

WK1.range(cells(ZAE,1),cells(ZANZ,1)).delete

Deine zwei Inputboxen sind eine Quelle für Fehleingaben, aber dazu
später mehr, klingt nach Userform mit zwei Listboxen dann sind
Fehleingaben (Schreibweisen) nicht mehr möglich.

Du hast da zwei Sort-Routinen. Eine soll nicht funktionieren. Was
genau funktioniert da nicht?

Sie unterscheiden sich ja nur in range(sk) bzw. rangge(ks).
Dadran kann das „irgendwie“ liegen. Gibt auch andere Gründe dafür.
Hast du eklige verbundene Zellen im Sortierbereich?
Anderen Schweinskram?
Such mal nach Unterschieden zwischen den Spalten von sk und ks.

Kannst du mit dem obersten Link in FAQ:2606 eine Beispielmappe hochladen?

For ZAE = 2 To ZANZ
 WERT = Format(WK1.Cells(ZAE, SP).Value, "##,##0")
 WK1.Cells(ZAE, SP).Value = WERT
 WK1.Cells(ZAE, SP).Font.Bold = True
 WK1.Cells(ZAE, SP).Font.Size = 12
Next ZAE

könnte man so schreiben:

with wk1.range(cells(2,sp),cells(ZANZ,sp))
.numberformat="##,##0"
.Font.Bold = True
.Font.Size = 12
end with

(ggfs. reicht Numberformat nicht, teste mal)

Gruß
Reinhard

Karlheinz_Feller · 12. November 2019 um 10:48

http://www.file-upload.net/download-4575628/Test2.xl…

Hallo Reinhard, schön das Du Dich nochmals meldest. Damit mir der Up-Load-Link nicht verloren geht, gleich oben reinkopiert. Mittlerweile habe ich das Modul soweit verfeinert, daß ich ganz gut damit zurecht komme. Im Test-Sheet wird sicherlich besser deutlich, was ich eigentlich will: Register „Tabelle5“ ist 1 Drill-Down von der Pivot Tabelle, Zelle „B5“. Ich finde, die Output Tabelle chaotisch, sowohl von der Formatierung der Zahlenwerte als auch von der Anzahl der Zeilen. Es sind sehr viele „Blindgänger“ dabei, ca.50-80% der Zeilen sind überflüssig, weil sie Leerzellen der Zelle „B5“ mit einstellen aber dazu müsste man sich wohl mal mit Leuten von MS unterhalten.
Der aktuelle Code:
****************************************************
Option Explicit

Sub Output()
Dim TABELL As String, BU As String, SK As String, LIST As String, KS As String, TAB1 As String, SR As String
Dim LST As ListObjects
Dim SP As Integer
Dim WERT As Double, TOTAL As Double
Dim WK1 As Worksheet
Dim ZAE As Long, LETZTE As Long, ZANZ As Long, I As Long, N As Long

TABELL = InputBox(„Eingabe Output-Tabelle“) ’ Ausgabedatei eingaben
BU = InputBox(„Eingabe Report-BU“) ’ Report BU
Set WK1 = Worksheets(TABELL)
WK1.Select

Selection.AutoFilter

WK1.Cells(2, 1).Activate
For I = 1 To Worksheets.Count
Set LST = Worksheets(I).ListObjects
For N = 1 To LST.Count
TAB1 = LST.Item(N).Name
Debug.Print TAB1
'MsgBox (Tabelle)
Next N
Next I

Application.ScreenUpdating = False
KS = „N1“ 'KSt Spalte"
ZAE = 2
Select Case BU
Case Is = „4-132“
SP = 2
Case Is = „4-134“
SP = 3
Case Is = „4-138“
SP = 4
Case Is = „4-139“
SP = 5
Case Is = „5-053“
SP = 6
Case Is = „5-054“
SP = 7
Case Is = „5-055“
SP = 8
End Select

Select Case SP
Case Is = 2
SK = „B1“
SR = „B:B“
Case Is = 3
SK = „C1“
SR = „C:C“
Case Is = 4
SK = „D1“
SR = „D:smiley:“
Case Is = 5
SK = „E1“
SR = „E:E“
Case Is = 6
SK = „F1“
SR = „F:F“
Case Is = 7
SK = „G1“
SR = „G:G“
Case Is = 8
SK = „H1“
SR = „H:H“
End Select

Worksheets(TABELL).ListObjects(TABELL).Sort.SortFields. _
Add Key:=Range(SK), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal

With ActiveWorkbook.Worksheets(TABELL).ListObjects(1).Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'****
ZAE = 2
Debug.Print ZANZ

Do Until WK1.Cells(ZAE, SP) = „“
ZAE = ZAE + 1
Loop

ZANZ = ZAE
Do Until IsEmpty(WK1.Cells(ZANZ, 1))
ZANZ = ZANZ + 1
Loop
WK1.Cells(ZAE, 1).Select
WK1.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Rows.Delete
ZANZ = ZAE - 1
ZAE = 2
WK1.Range(„B:H“).Select
Selection.NumberFormat = „##,##0“
WK1.Range(SR).Select
Selection.Font.Size = 12
Selection.Font.Bold = True

WK1.Cells(ZANZ + 1, SP).Select

TOTAL = 0

'For für die Summe wäre zu ersetzen mit Application.Sum wk1.range(Cells(…
************************
For ZAE = 2 To ZANZ 'Summe bilden der Berichtsspalte und in letzter Zelle der Sp.speichern
TOTAL = TOTAL + WK1.Cells(ZAE, SP)
Next ZAE

WK1.Cells(ZAE, SP).Value = TOTAL
Application.ScreenUpdating = True

End Sub
************************************************
ein paar Kleinigkeiten sind dabei, die mich noch irritieren bzw. von denen ich denke, das sie noch optimiert werden könnten. z.B. die For-Schleife zur Summenbildung könnte sicherlich ersetzt werden mit application.sum, doch ich habe immer Probleme mit Range(Cells(Var… noch dazu, wenn ich nicht im aktuellen Sheet bleiben kann, wie in diesem Fall(starte ja von der Pivot Tabelle aus. Was mich noch ein bisschen irritiert, das Modul „arbeitet nach“ Klingt komisch, aber ich kann es nicht anders formulieren. Das sieht so aus: wenn ich nach Ende des Ablaufes in ein anderes Sheet wechseln oder das Sheet schließen will, dann sieht es so aus, als wenn Excel sich aufgehängt hat. Es erscheint ein blasser Screen und die „Eieruhr“ erscheint. Dauert ca. 10 Sek., dann ist der Spuk vorbei. Keine Ahnung, kann damit leben, aber wenn ich schon 1 Experten wie Dich fragen kann, dann nutze ich die Gelegenheit, vielleich fällt Dir ja was dazu ein.
Bin für jeden Tipp dankbar und freue mich, wenn ich was dazu lernen kann.

Freue mich, von Dir zu hören.

viele Grüsse
Karlheinz

P.S.: hast Du die Mail tatsächlich um 4:00 Morgens reingestellt ?