Excel Macro XXL

[TBlokland]

Hallo,

Ik ben voor een project op het werk bezig met het converteren van CRM (Customer Relation Management) van het ene naar het andere automatiseringssysteem. De data vertaler hierbij is Excel.

Wat is de bedoeling?
Heel simpel, Uit het huidige systeem komt de data in losse regels. Voor de import in het nieuwe moet dat samengevoegd zijn.
In het voorbeeld bestand is dat b.v. regel 3 staat de volledige data reeks in de kolommen met in kolom F een opmerking van een medewerker. In 4F gaat deze opmerking van de medewerker verder. Deze twee cellen in regel 3 en 4 kolom F moeten samen gevoegd worden. En dan dit voor alle regels. Let op. het is helaas niet altijd dezelfde sprong in regels. Soms zijn het twee, soms drie, vier of vijf regels waarvan de cellen in kolom F samengevoegd moeten worden.

Ik kan me dit ongeveer bedenken maar weet niet hoe dat te programmeren:
Als A3 "datum" EN C3 "getal" EN C4 = leeg EN E4leeg = Samenvoegen F3 EN F4 etc... maar dan weer niet als er wel tekst in de vervolg regel staat...

Onderstaand een voorbeeld bijgevoegd. Dit is maar een fractie van de data die te converteren is. In totaal zijn het meer dan 50K regel die moeten worden behandeld, vandaar de zoektocht naar een Marco c.q. automatisering hierin.

Afijn gecompliceerd verhaal en ik hoop op een superieur Excellateur die dit kan oplossen!

Groet Thijs

Bekijk bijlage CRM VRBLD Converteren Cash-ENK.xls

 

[Peter B]

Laat ik voorop stellen dat ik geen VBA goeroe ben. Kortom, onderstaande code kan vast slimmer/ beter/ robuuster. Maar als iets als het volgende al niet lukt weet ik niet of je je hier wel aan moet wagen. Om de code te laten runnen heb je naast "Cash" ook een werkblad nodig met als naam "Sheet1"

Sub samenvoegen()

Dim arrayIn As Variant
Dim arrayOut As Variant
Dim i As Long
Dim j As Long

arrayIn = ThisWorkbook.Sheets("Cash").Range("A3").CurrentRegion
ReDim arrayOut(1 To UBound(arrayIn, 1), 1 To UBound(arrayIn, 2))

j = 0
For i = 2 To UBound(arrayIn, 1)
    If arrayIn(i, 1) <> "" Then
        j = j + 1
        arrayOut(j, 1) = arrayIn(i, 1)
        arrayOut(j, 2) = arrayIn(i, 2)
        arrayOut(j, 3) = arrayIn(i, 3)
        arrayOut(j, 4) = arrayIn(i, 4)
        arrayOut(j, 5) = arrayIn(i, 5)
        arrayOut(j, 6) = arrayIn(i, 6)
        arrayOut(j, 7) = arrayIn(i, 7)
    Else
        arrayOut(j, 6) = arrayOut(j, 6) & vbNewLine & arrayIn(i, 6)
    End If
Next i

ThisWorkbook.Sheets("Sheet1").Range("A1:G" & UBound(arrayOut, 1)) = arrayOut

End Sub