Ziel der Arbeit ist, dass jede Kundennummer nur noch auf einer Zeile vorkommt und die Einträge in einer Zeile zusammengefasst werden. Ist das ohne VBA Programmierung möglich?
A | B | C | D | E | F | G | H | I | J | K | L | M | |
1 | FALLNR1 | KST | WiederEin | GebDatum1 | OPDatum1 | Kategorie1 | OPCODE01 | OPCODE02 | OPCODE03 | OPCODE04 | OPCODE05 | OPCODE06 | OPCODE07 |
2 | 1 | 1201080 | 0 | 21.02.1981 | 12.06.2015 | Stationär | 88.74.10 | 49.21 | 48.23 | ||||
3 | 2 | 1201081 | 0 | 02.01.1924 | 28.10.2015 | Stationär | 81.52.10 | ||||||
4 | 3 | 1201083 | 0 | 13.05.1964 | 14.12.2015 | Stationär | 34.51 | 34.21.10 | 34.59.20 | ||||
5 | 4 | 1201083 | 0 | 21.02.1989 | 12.05.2015 | Stationär | 34.21.10 | 34.6X.21 | 32.2 | 34.09.10 | |||
6 | 5 | 1302081 | 0 | 19.01.2007 | 08.05.2015 | Stationär | 86.22.19 | 79.37.40 | |||||
7 | 6 | 1201081 | 0 | 22.10.1955 | 01.07.2015 | Stationär | 78.13.10 | 79.32.10 | |||||
8 | 7 | 1302081 | 0 | 01.09.2013 | 14.01.2015 | Stationär | 58.45 | ||||||
9 | 8 | 1207080 | 0 | 26.10.1931 | 21.01.2015 | Stationär | 22.2 | 21.22 | 22.2X.11 | 22.41.11 | 22.51 | 22.52 | |
10 | 9 | 1204080 | 0 | 20.01.2004 | 02.02.2015 | Stationär | 81.47.15 | 81.47.15 | |||||
11 | 10 | 1204080 | 0 | 05.03.1980 | 16.01.2015 | Stationär | 77.51 | ||||||
12 | 11 | 1204080 | 0 | 20.09.1949 | 07.04.2015 | Stationär | 81.51 | ||||||
13 | 12 | 1204080 | 0 | 30.05.1976 | 16.01.2015 | Stationär | 77.68 | ||||||
14 | 13 | 1208080 | 0 | 06.03.1996 | 21.01.2015 | Stationär | 76.66.10 | 76.62.10 | |||||
15 | 14 | 1204080 | 0 | 01.06.1942 | 13.01.2015 | Stationär | 03.09.34 | 03.09.44 | 77.49.21 | 03.09.34 | 03.09.91 | 00.99.20 | 03.09.35 |
16 | 15 | 1204080 | 0 | 31.05.1933 | 01.12.2015 | Stationär | 81.51 |
Formeln der Tabelle | ||||||||
|
A | B | C | D | E | F | G | H | I | J | K | L | M | |
1 | FALLNR1 | KST | WiederEin | GebDatum1 | OPDatum1 | Kategorie1 | OPCODE01 | OPCODE02 | OPCODE03 | OPCODE04 | OPCODE05 | OPCODE06 | OPCODE07 |
2 | 1 | 1201080 | 0 | 21.02.1981 | 12.06.2015 | Stationär | 88.74.10 | 49.21 | 48.23 | ||||
3 | 2 | 1201081 | 0 | 02.01.1924 | 28.10.2015 | Stationär | 81.52.10 | ||||||
4 | 3 | 1201083 | 0 | 13.05.1964 | 14.12.2015 | Stationär | 34.51 | 34.21.10 | 34.59.20 | ||||
5 | 4 | 1201083 | 0 | 21.02.1989 | 12.05.2015 | Stationär | 34.21.10 | 34.6X.21 | 32.2 | 34.09.10 | |||
6 | 5 | 1302081 | 0 | 19.01.2007 | 08.05.2015 | Stationär | 86.22.19 | 79.37.40 | |||||
7 | 6 | 1201081 | 0 | 22.10.1955 | 01.07.2015 | Stationär | 78.13.10 | ||||||
8 | 6 | 1201081 | 0 | 22.10.1955 | 07.07.2015 | Stationär | 79.32.10 | ||||||
9 | 7 | 1302081 | 0 | 01.09.2013 | 14.01.2015 | Stationär | 58.45 | ||||||
10 | 8 | 1207080 | 0 | 26.10.1931 | 21.01.2015 | Stationär | 22.2 | 21.22 | 22.2X.11 | 22.41.11 | 22.51 | 22.52 | |
11 | 9 | 1204080 | 0 | 20.01.2004 | 02.02.2015 | Stationär | 81.47.15 | 81.47.15 | |||||
12 | 10 | 1204080 | 0 | 05.03.1980 | 16.01.2015 | Stationär | 77.51 | ||||||
13 | 11 | 1204080 | 0 | 20.09.1949 | 07.04.2015 | Stationär | 81.51 | ||||||
14 | 12 | 1204080 | 0 | 30.05.1976 | 16.01.2015 | Stationär | 77.68 | ||||||
15 | 13 | 1208080 | 0 | 06.03.1996 | 21.01.2015 | Stationär | 76.66.10 | 76.62.10 | |||||
16 | 14 | 1204080 | 0 | 01.06.1942 | 13.01.2015 | Stationär | 03.09.34 | 03.09.44 | 77.49.21 | 03.09.34 | 03.09.91 | 00.99.20 | |
17 | 14 | 1204080 | 0 | 01.06.1942 | 07.01.2015 | Stationär | 03.09.35 | 80.51.11 | 03.09.34 | 81.08 | 78.49.8 | 88.39.10 | 00.99.20 |
Option Explicit
Sub GanzNeu()
Dim a As Variant, b As Variant, c As Variant
Dim i&, j&, k&, maxz&, z&
Dim letzter
Dim s$
Dim gefunden As Boolean
Dim shO As Worksheet, shT As Worksheet
Dim maxw&, w&
Dim t As Single
t = Timer
Set shO = Sheets("Original")
Set shT = Sheets("Test2")
shT.Cells.Clear
maxz = shO.Range("A" & shO.Rows.Count).End(xlUp).Row
shO.Range("A1").CurrentRegion.Copy shT.Range("A1")
Application.CutCopyMode = False
'shT.Range("A1").CurrentRegion.RemoveDuplicates _
' Columns:=Array(1, 2, 3, 4), Header:=xlYes
shT.Range("A1").CurrentRegion.RemoveDuplicates _
Columns:=1, Header:=xlYes
a = shO.Range("A1:A" & maxz + 1)
b = shO.Range("G1:Q" & maxz + 1)
c = shO.Range("R1:R" & maxz + 1) ' muß eine leere Spalte sein, evtl. weiter rechts
s = ""
z = 3
gefunden = False
letzter = -1
maxw = 0
For i = 3 To maxz
If a(i, 1) = letzter Then
gefunden = True
If w = 0 Then
For k = 1 To 11
If b(i - 1, k) "" Then
w = w + 1
Else
Exit For
End If
Next
End If
For k = 1 To 11
If b(i, k) "" Then
s = s & "'" & b(i, k) & "!"
Else
Exit For
End If
Next
' Stop
Else
If gefunden Then
' Stop
c(z - 1, 1) = s
s = ""
a(z - 1, 1) = w
w = 0
End If
z = z + 1
gefunden = False
End If
letzter = a(i, 1)
a(i, 1) = 0
Next
'shT.Range("R1:R" & z) = c
'shT.Range("S1:S" & z) = a
'MsgBox ""
For k = 2 To z
If c(k, 1) "" Then
b = Split(c(k, 1), "!")
If UBound(b) > 0 Then
shT.Cells(k, a(k, 1) + 7).Resize(1, UBound(b)) = b
End If
End If
Next
MsgBox (Timer - t) * 1000 & "ms"
End Sub
Unausgesprochene Voraussetzung: die Daten sind nach Spalte A sortiert.