VBA: Zellen auf 2 Zeilen aufteilen
Erich
Hi Fan,
probier mal
Option Explicit
Sub Aufteile()
Dim lngQ As Long, lngC As Long, arQ, arZ(), zz As Long, cc As Long
Const cTeile As Long = 2
With Sheets("Tabelle1")
lngQ = LetzteZeileInBereich(.Columns("A:F"))
zz = lngQ Mod cTeile
If zz > 0 Then lngQ = lngQ + cTeile - zz
lngC = LetzteSpalteInBereich(.Columns("A:F"))
zz = lngC Mod cTeile
If zz > 0 Then lngC = lngC + cTeile - zz
arQ = .Cells(1, 1).Resize(lngQ, lngC)
End With
ReDim arZ(1 To lngQ * cTeile, 1 To lngC / cTeile)
For zz = 1 To UBound(arZ)
For cc = 1 To UBound(arZ, 2)
arZ(zz, cc) = arQ(1 + Int((zz - 1) / cTeile), _
cc + lngC / cTeile * ((zz - 1) Mod cTeile))
Next cc
Next zz
With Sheets("Tabelle2")
.Cells.ClearContents
.Cells(1, 1).Resize(UBound(arZ), UBound(arZ, 2)) = arZ
End With
End Sub
Function LetzteZeileInBereich(rngB As Range) As Long
Dim rng As Range
With rngB
Set rng = .Find("*", .Cells(1, 1), xlValues, , xlByRows, xlPrevious)
If rng Is Nothing Then
LetzteZeileInBereich = .Cells(1, 1).Row
Else
LetzteZeileInBereich = rng.Row
End If
End With
End Function
Function LetzteSpalteInBereich(rngB As Range) As Long
Dim rng As Range
With rngB
Set rng = .Find("*", .Cells(1, 1), xlValues, , xlByColumns, xlPrevious)
If rng Is Nothing Then
LetzteSpalteInBereich = .Cells(1, 1).Column
Else
LetzteSpalteInBereich = rng.Column
End If
End With
End Function
Ohne VBA gehts einfacher (Formel von A1 nach rechts und unten kopieren):
| A | B | C |
1 | war A1 | war B1 | war C1 |
2 | war D1 | war E1 | war F1 |
3 | war A2 | war B2 | war C2 |
4 | war D2 | war E2 | war F2 |
5 | war A3 | war B3 | war C3 |
6 | war D3 | war E3 | war F3 |
7 | war A4 | war B4 | war C4 |
8 | war D4 | war E4 | war F4 |
9 | war A5 | war B5 | war C5 |
10 | war D5 | war E5 | war F5 |
11 | war A6 | | war C6 |
12 | war D6 | | war F6 |
13 | war A7 | | |
14 | 0 | | |
15 | war A8 | | |
16 | 0 | | |
17 | war A9 | | |
18 | 0 | | |
19 | war A10 | | |
20 | 0 | | |
21 | | | |
Formeln der Tabelle |
Zelle | Formel | A1 | =WENN(ZEILE()>2*ANZAHL2(Tabelle1!A:A); ""; INDEX(Tabelle1!$A$1:$F$10;(ZEILE()+1)/2;SPALTE()+3*REST(ZEILE()+1;2))) |
|
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich