Lösunsversuch in Excel und Vba
Eine Adressliste mit ca. 300 Adressen soll in einer bestimmten
Reihenfolge sortiert werden.
Würde ich jetzt die Adressen hintereinander auf die Blätter
drucken wären die geschnittenen Ausdrucke ja ziemlich
durcheinander, also müsste die Quelldatei, sprich in diesem
Fall die Excel-Tabelle, so sortiert werden, daß der zweite
Eintrag an zehnter Stelle, der dritte an 19. usw. steht.
Hi Holger,
ich hoffe ich habe dich richtig verstanden, ausgehend von
Tabellenblatt: F:\[spezialsortierung.xls]!Tabelle1
│ A │
───┼────────┤
1 │ Text1 │
───┼────────┤
2 │ Text2 │
───┼────────┤
3 │ Text3 │
───┼────────┤
4 │ Text4 │
───┼────────┤
5 │ Text5 │
───┼────────┤
6 │ Text6 │
───┼────────┤
7 │ Text7 │
───┼────────┤
8 │ Text8 │
───┼────────┤
9 │ Text9 │
───┼────────┤
10 │ Text10 │
───┼────────┤
11 │ Text11 │
───┼────────┤
12 │ Text12 │
───┴────────┘
erreichst du die folgende sortierte Tabelle durch die Formeln (Spalte B) bzw. durch Makros (Spalte A und C):
Lösung in A: reine Vba-Lösung
Lösung in B: reine Excellösung
Lösung in C: Mischung aus A und B, du läßt das makro xsort2() laufen, dann löscht du das Modul1 und die Formeln stimmen und die Mappe ist Makrofrei.
Tabellenblatt: F:\[spezialsortierung.xls]!Tabelle2
│ A │ B │ C │
───┼────────┼────────┼────────┤
1 │ Text1 │ Text1 │ Text1 │
───┼────────┼────────┼────────┤
2 │ Text10 │ Text10 │ Text10 │
───┼────────┼────────┼────────┤
3 │ Text20 │ Text20 │ Text20 │
───┼────────┼────────┼────────┤
4 │ Text30 │ Text30 │ Text30 │
───┼────────┼────────┼────────┤
5 │ Text40 │ Text40 │ Text40 │
───┼────────┼────────┼────────┤
6 │ Text50 │ Text50 │ Text50 │
───┼────────┼────────┼────────┤
7 │ Text60 │ Text60 │ Text60 │
───┼────────┼────────┼────────┤
8 │ Text70 │ Text70 │ Text70 │
───┼────────┼────────┼────────┤
9 │ Text80 │ Text80 │ Text80 │
───┼────────┼────────┼────────┤
10 │ Text2 │ Text2 │ Text2 │
───┼────────┼────────┼────────┤
11 │ Text11 │ Text11 │ Text11 │
───┼────────┼────────┼────────┤
12 │ Text21 │ Text21 │ Text21 │
───┴────────┴────────┴────────┘
Benutzte Formeln:
B1 : =INDIREKT("Tabelle1!A"&WENN(RZ=0;ZZ+1;GANZZAHL(10\*RZ+ZZ))+72\*GANZZAHL(ZZ/9))
B2 : =INDIREKT("Tabelle1!A"&WENN(RZ=0;ZZ+1;GANZZAHL(10\*RZ+ZZ))+72\*GANZZAHL(ZZ/9))
B3 : =INDIREKT("Tabelle1!A"&WENN(RZ=0;ZZ+1;GANZZAHL(10\*RZ+ZZ))+72\*GANZZAHL(ZZ/9))
B4 : =INDIREKT("Tabelle1!A"&WENN(RZ=0;ZZ+1;GANZZAHL(10\*RZ+ZZ))+72\*GANZZAHL(ZZ/9))
B5 : =INDIREKT("Tabelle1!A"&WENN(RZ=0;ZZ+1;GANZZAHL(10\*RZ+ZZ))+72\*GANZZAHL(ZZ/9))
B6 : =INDIREKT("Tabelle1!A"&WENN(RZ=0;ZZ+1;GANZZAHL(10\*RZ+ZZ))+72\*GANZZAHL(ZZ/9))
B7 : =INDIREKT("Tabelle1!A"&WENN(RZ=0;ZZ+1;GANZZAHL(10\*RZ+ZZ))+72\*GANZZAHL(ZZ/9))
B8 : =INDIREKT("Tabelle1!A"&WENN(RZ=0;ZZ+1;GANZZAHL(10\*RZ+ZZ))+72\*GANZZAHL(ZZ/9))
B9 : =INDIREKT("Tabelle1!A"&WENN(RZ=0;ZZ+1;GANZZAHL(10\*RZ+ZZ))+72\*GANZZAHL(ZZ/9))
B10: =INDIREKT("Tabelle1!A"&WENN(RZ=0;ZZ+1;GANZZAHL(10\*RZ+ZZ))+72\*GANZZAHL(ZZ/9))
B11: =INDIREKT("Tabelle1!A"&WENN(RZ=0;ZZ+1;GANZZAHL(10\*RZ+ZZ))+72\*GANZZAHL(ZZ/9))
B12: =INDIREKT("Tabelle1!A"&WENN(RZ=0;ZZ+1;GANZZAHL(10\*RZ+ZZ))+72\*GANZZAHL(ZZ/9))
C1 : =Tabelle1!A1
C2 : =Tabelle1!A10
C3 : =Tabelle1!A20
C4 : =Tabelle1!A30
C5 : =Tabelle1!A40
C6 : =Tabelle1!A50
C7 : =Tabelle1!A60
C8 : =Tabelle1!A70
C9 : =Tabelle1!A80
C10: =Tabelle1!A2
C11: =Tabelle1!A11
C12: =Tabelle1!A21
Festgelegte Namen:
RZ: =REST(ZEILE()-1;9)
ZZ: =(ZEILE()-1)/9
A1:C12
haben das Zahlenformat: Standard
Tabellendarstellung erreicht mit dem Code in FAQ:2363
Die Formeln in Spalte B gibst du in B1 ein und kopierst sie runter.
Für Spalte A rufst du das makro Xsort() auf, für Spalte C das makro xsort2().
Makrocodes im Anhang
Hinweis, wenn du die Codes im Editor einfügst und manche Zeilen sind grün, so war das mal eine Zeile und wurde durch w-w-w in 2 Zeilen umgebrochen, mache wieder eine Zeile daraus und fertig.
Gruß
Reinhard
in Modul1:
Option Explicit
'
Sub Xsort()
Dim wks1 As Worksheet, Z1 As Long, Z2 As Byte, Z3 As Byte, Max As Long, M As Long
Set wks1 = Worksheets("Tabelle1")
Application.ScreenUpdating = False
With Worksheets("Tabelle2")
.Columns(1).ClearContents
Max = wks1.Cells(Rows.Count, 1).End(xlUp).Row ' 300
For Z1 = 0 To Max Step 81
For Z2 = 0 To 8
For Z3 = 1 To 9
M = M + 1
If M \> Max Then GoTo Ende
.Cells(Z1 + (Z3 - 1) \* 9 + Z2 + 1, 1) = wks1.Cells(M + IIf(Z2 = 0, Z2, Z2 - 1), 1)
Next Z3
Next Z2
Next Z1
End With
Ende:
Application.ScreenUpdating = True
End Sub
'
Sub Xsort2()
Dim wks1 As Worksheet, Z1 As Long, Z2 As Byte, Z3 As Byte, Max As Long, M As Long
Set wks1 = Worksheets("Tabelle1")
Application.ScreenUpdating = False
With Worksheets("Tabelle2")
.Columns(3).ClearContents
Max = wks1.Cells(Rows.Count, 1).End(xlUp).Row ' 300
For Z1 = 0 To Max Step 81
For Z2 = 0 To 8
For Z3 = 1 To 9
M = M + 1
If M \> Max Then GoTo Ende
If wks1.Cells(M + IIf(Z2 = 0, Z2, Z2 - 1), 1) "" Then
.Cells(Z1 + (Z3 - 1) \* 9 + Z2 + 1, 3).FormulaLocal = \_
"=" & wks1.Name & "!A" & M + IIf(Z2 = 0, Z2, Z2 - 1)
End If
Next Z3
Next Z2
Next Z1
End With
Ende:
Application.ScreenUpdating = True
End Sub
