Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1364to1368
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

Automatische Verkettung unterschiedlicher Anzahl

Automatische Verkettung unterschiedlicher Anzahl
03.06.2014 18:41:43
Sönke
Hallo,
ich habe ein Problem, welches ich in Excel früher immer Händisch gelöst habe.
Meine Daten sehen folgendermaßen aus (Spalte A und B vorgegeben, Spalte C erwünschtes Ergebnis):
A | B | C
20| 0005500|
21| 0005483|
22| 0005439|
22| 0005501| 0005439; 0005501
23| 0005427|
24| 0005470|
24| 0005509| 0005470; 0005509
durch eine Verkettungsfunktion hier aus dem Forum:
https://www.herber.de/forum/archiv/576to580/t577306.htm
habe ich mir dann eben händisch die jeweiligen Bereiche markiert und gut.
Leider habe ich nun rund 28tsd Zeilen, da ist diese Lösung nicht mehr möglich.
Ich habe versucht einen Ansatz in VBA zu schreiben, habe leider nur Basis C Kenntnisse und komme nicht weiter.
Kurz zur Funktion: Solange die Zahlen in Spalte A gleich sind, sollen die Daten mit einem "; " verkettet werden und dann in Spalte C erscheinen, in der Zeile wo die letzte der identischen Zahlen ist (siehe oben).
Mein Ansatz sieht wie folgt aus (Bitte nicht lachen):

Sub Test()
Dim i, j As Integer
Dim ergebnis As String
Do Until DieseMappe.Tabelle1.Range("A" & i + 1 = "A" & i)
i = i + 1
Loop
For Each rng In "A"&j: "A"&i
If rng  "" Then
ergebnis = ergebnis & rng & "; "
End If
Next
Cells(i, 5) = ergebnis
j = i
End Sub

Wie gesagt mir fehlt jegliche Kenntnis in VBA und ein guter C-Programmierer war ich auch noch nie.
Ich würde mich freuen wenn mir jemand mit meinem Problem weiterhelfen kann!
Vielen Dank im Vorraus!
Gruß Sönke

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Automatische Verkettung unterschiedlicher Anzahl
04.06.2014 01:30:45
fcs
Hallo Sönke,
hier ein Makro mit entsprechender Funktionalität.
Gruß
Franz
Sub Test()
Dim wks As Worksheet
Dim i As Long, j As Long, StatusCalc As Long
Dim ergebnis As String
'passendes Setzen des Worksheet-Objekts wählen
Set wks = ActiveSheet
'Set wks = ActiveWorkbook.Worksheets(1)
'Set wks = ActiveWorkbook.Worksheets("TabelleABC")
Const lngStartzeile As Long = 2       'ggf. anpassen
'Makrobremsen lösen
With Application
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
With wks
'letzte Zeile mit Wert in Spalte A
j = .Cells(.Rows.Count, 1).End(xlUp).Row
'Inhalte in Zielspalte C löschen
.Range(.Cells(lngStartzeile, 3), .Cells(j, 3)).ClearContents
ergebnis = ""
For i = lngStartzeile To j + 1 '+ 1 damit für letzte Zeile ggf. noch das Ergebnis  _
eingetragen wird
If .Cells(i, 1) = .Cells(i + 1, 1) Then
ergebnis = IIf(ergebnis = "", "", ergebnis & ";") & .Cells(i, 2).Text
ElseIf ergebnis  "" Then
ergebnis = IIf(ergebnis = "", "", ergebnis & ";") & .Cells(i, 2).Text
.Cells(i, 3) = "'" & ergebnis
ergebnis = ""
End If
Next
End With
'Makrobremsen zurücksetzen
With Application
.ScreenUpdating = True
.Calculation = StatusCalc
End With
End Sub

Anzeige
AW: Automatische Verkettung unterschiedlicher Anzahl
05.06.2014 17:06:15
Sönke
Hallo Franz,
vielen Dank für die extrem schnelle Anwort!
Heute morgen direkt getestet und funktioniert super.
Tausend Dank!!!

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige