test in cellen samenvoegen in vba
Jan B.
met onderstaande code voeg ik de inhoud van 5 naast elkaar liggende cellen
bij elkaar, gescheiden door een komma.
Dat gaat goed. Het aantal regels is echter dermate groot dat er een storende
traagheid optreedt. Dit duurt 12 seconden (waar zeurt ie over, hoor ik u
denken), dat is echter te lang. Een versnelling van een factor 10 is zeer
welkom.
Ik zocht naar de functie "join" in vba maar de info hierover is summier, een
voorbeeld ontbreekt onder F1 en ik vind geen goeie voorbeelden.
' samenvoegen
For Each cel In Range("D11:D40000")
a = cel.Value & " " & _
cel.Offset(0, 1).Value & " " & _
cel.Offset(0, 2).Value & " " & _
cel.Offset(0, 3).Value & " " & _
cel.Offset(0, 4).Value & " "
cel.Value = a
Next cel
Wie helpt ?
--
met vriendelijke groet,
Jan B.
zonder dit @hotmailpuntcom john philippen
het lijkt mij niet mogelijk om jouw code veel sneller te schrijven.
je code bevat volgens mij ook een "logische" fout.
als je de code namelijk 2 keer laat lopen dan wordt de inhoud verdubbeld in
de D range.
mijn voorstel is het volgende:
a) laat deze code indien gegevens al zijn ingevuld eenmaal draaien (1 keer
12 seconden)
b) maak gebruik van onderstaande code
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("e11:I40000")) Is Nothing Then
Cells(Target.Row, 4) = Cells(Target.Row, 5) & " " & Cells(Target.Row, 6)
& " " & _
Cells(Target.Row, 7) & " " & Cells(Target.Row, 8) & " " &
Cells(Target.Row, 9)
End If
End Sub
R-Klik op blad1 (of hoe je dat blad genoemd hebt)
kies voor programmacode weergeven
plak dan de code
volgens mij heb je zo een optimale code!
m.v.g.
John Philippen
--
Vragen is nooit dom.
Met een vraag blijven lopen wel.
Want dat lost nooit iets op.
MarcoS
> Jan,
>
> het lijkt mij niet mogelijk om jouw code veel sneller te schrijven.
> je code bevat volgens mij ook een "logische" fout.
> als je de code namelijk 2 keer laat lopen dan wordt de inhoud verdubbeld in
> de D range.
>
> mijn voorstel is het volgende:
>
> a) laat deze code indien gegevens al zijn ingevuld eenmaal draaien (1 keer
> 12 seconden)
> b) maak gebruik van onderstaande code
>
> Private Sub Worksheet_Change(ByVal Target As Range)
> If Not Intersect(Target, Range("e11:I40000")) Is Nothing Then
> Cells(Target.Row, 4) = Cells(Target.Row, 5) & " " & Cells(Target.Row, 6)
> & " " & _
> Cells(Target.Row, 7) & " " & Cells(Target.Row, 8) & " " &
> Cells(Target.Row, 9)
> End If
> End Sub
>
> R-Klik op blad1 (of hoe je dat blad genoemd hebt)
> kies voor programmacode weergeven
> plak dan de code
>
> volgens mij heb je zo een optimale code!
>
> m.v.g.
> John Philippen
Dag Jan,
Als je zit te wachten lijkt 12 seconden lang maar excel moet ook 40.000
regels door. Dat is best veel. Misschien kan je nog wat tijd winnen door
Application.ScreenUpdating = False in de code op te nemen.
MVrGr,
Marco
jan
Een factor 10 haalt deze code niet, maar binnen 2 seconden zou het zo wel moeten
lukken:
Sub combineren()
Dim var(39989, 0)
Dim a As String
Dim i As Long
For i = 1 To 39990
For Each rng In Range("D" & 10 + i & ":H" & 10 + i)
a = a & rng & " "
Next
var(i - 1, 0) = Trim(a)
a = ""
Next
Range("D11:D40000") = var
End Sub
Jan
jan
De komma vergeten.
Met komme wordt het dit:
Sub combineren()
Dim var(39989, 0)
Dim a As String
Dim i As Long
For i = 1 To 39990
For Each rng In Range("D" & 10 + i & ":H" & 10 + i)
a = a & "," & rng
Next
var(i - 1, 0) = Mid(a, 2)
jan
Als het dan toch nog sneller moet dan zou je dit kunnen gebruiken:
Sub combineren2()
Dim var(39989, 0)
Dim var1 As Variant
Dim a As String
Dim i As Long
Dim k As Long
var1 = Range("D11:H40000")
For i = 1 To 39990
For k = 1 To 5
a = a & "," & var1(i, k)
Next
var(i - 1, 0) = Mid(a, 2)
a = ""
Next
Range("D11:D40000") = var
End Sub
Deze zou inderdaad meer dan een factor 10 sneller kunnen zijn dan je oorspronkelijke
procedure (bij mij in ą 0,6 seconden)
Jan
Jan B.
ik heb 't allemaal geprobeerd.
De snelste oplossing kwam uiteindelijk van Mr.T op het forum "worksheet.nl"
Helaas kan ik hem daar momenteel niet voor bedanken daar ik mij schuldig
gemaakt heb aan "crosspost" en daarom 8 dagen geen toegang meer krijg tot
deze site. Mocht Mr.T toch "stiekem" ook hier rondkijken: bedankt.
Mijn eigen routine heeft in de toepassing 14 seconden nodig
die van jan 3,64
die van Mr.T 1,52. Die neem ik.
De oplossing zit in, net zoals jan dat deed, in het gebruik een array:
arr = Range("D11:H40000").Value
For n = LBound(arr, 1) To UBound(arr, 1)
arr(n, 1) = arr(n, 1) & " " & arr(n, 2) & " " & arr(n, 3) & " " & _
arr(n, 4) & " " & arr(n, 5) & " "
Next n
Range("D11:H60000").Value = arr
voila!
hartelijk bedankt voor jullie reacties.
--
met vriendelijke groet,
Jan B.
"Jan B." schreef:
jan
Ik kan het even niet laten.
Hett lijkt me vreemd dat die van Mr.T sneller is aangezien daar de resultaat matrix
5x zo groot is als bij mijn oplossing en deze dus bij plaatsen in Excel trager zal
zijn.
Wel zou je kunnen denken dat het ontbreken van de tweede lus wat snelheidswinst
oplevert, dat blijkt niet meetbaar.
Bij testen bleek die van mij ongeveer een factor 1,5 keer sneller (0,8 s tegenover
1,2 s bij 60000 rijen)
Dan heb ik het wel over mijn laatste oplossing, wellicht heb je alleen mijn eerste
oplossing bekeken, die inderdaad wat trager is (2,34 s bij 60000 rijen)
Als je wel mijn laatste oplossing hebt getest dan moeten we denk ik vast stellen dat
er een wat merkwaardig testverschil is.
En is die van Mr T. dus bij jou inderdaad sneller, dan moet je die uiteraard
gebruiken.
Jan
Jan B.
Ik heb je onderschat. Hoe kan ik ook . . .
Je hebt met twee arrays gewerkt, een voor het 5 kolommen breed bereik en een
voor het nieuwe bereik van kolom D. Het resultaat is bij mij 0,22 seconde.
Chapeau!
Wel is mij niet geheel duidelijk waarom je de dimensionering van var
ingesteld hebt op 39989.
Ik wil overigens die routine uiteindelijk loslaten op een variabel gebied.
Het eindadres kan dus ook bijvl H20000 zijn. Dat betekent dat in de praktijk
het getal 39990 variabel mag zijn. Ik zou m.i. nog snelheidswinst krijgen als
ik dus de arrays in kan korten.
De laatste rij voor arr wordt berekend in de variabele 'lastrij'.
ik Dim arr als volgt: Dim arr() as variant
ReDim arr(1 To lastrij, 0 To 0)
Helaas krijg ik een foutmelding in de regel:
arr(n - 1, 0) = a
subscript valt buiten bereik.
Misschien dat je nog zin hebt om je daar nog even over te buigen.
voor de duidelijkheid de aangepaste routine:
' jan , forum microsoft
Dim arr As Variant 'was Dim arr(39989, 0)
Dim var1 As Variant
Set rng = Range("D11:H" & lastrij + 10)
ReDim arr(1 To lastrij, 0 To 0)
a = ""
' lees alle kolommen in naar matrix-array
var1 = rng 'was Range("D11:H40000")
For n = 1 To lastrij 'was 39990
a = ""
' koppel teksten in 5 kolommen naar array voor kolom D
For kol = 1 To 5
a = a & " " & var1(n, kol)
Next
arr(n - 1, 0) = a
Next
Range("D11:D40000") = arr ' rng = arr
--
met vriendelijke groet,
Jan B.
"jan" schreef:
Jan B.
ik heb 'm al. arr begint bij 1 dus 'n-1' moet 'n' zijn
Het eindresultaat:
Sub samenvoegen()
Dim arr as variant, var1 as variant
Set rng = Range("D11:H" & lastrij + 10)
ReDim arr(1 To lastrij, 0 To 0)
a = ""
' lees alle kolommen in naar bereik-array
var1 = rng
For n = 1 To lastrij
a = ""
' koppel kolomteksten naar array voor kolom D
For kol = 1 To 5
a = a & " " & var1(n, kol)
Next
arr(n, 0) = a
Next
rng = arr
0,02 seconde. Gemeten bij 212 regels.
Bedankt voor het meedenken.
--
met vriendelijke groet,
Jan B.
"jan" schreef:
jan
Om dezelfde reden had ik de dimensie 39989 gekozen.
Immers het betrof 39990 rijen, terwijl de matrix bij 0 begint.
Maar met LBound en UBound zoals Mr.T. dat deed heb je daar een flexibeler aanpak.
En zoals je dat nu hebt gedaan, met lastrij en ReDim, geldt dat uiteraard ook.
Jan
Frits
Ik heb niets getest, maar gevoelsmatig zeg ik: je eerste opmerking
join
arr(n,0) = Join(Array(Cells(n, 4), Cells(n, 5), Cells(n, 6), Cells(n,
7),
Cells(n, 8)), " ")
in plaats van de loop kol 1 tot 5 misschien nog wat sneller ?
vr gr
Frits
jan
Wat Frits voorstelt is handig (en wellicht sneller) als je alle handelingen
rechtstreeks op ranges uitvoert, zoals jij in het begin deed. Maar dit levert t.o.v.
het werken met matrixen, zoals in de laatste oplossingen, beslist geen
snelheidswinst meer, integendeel.
De functie Array heb jij vervangen door arr2, wat waarschijnlijk een variant of een
matrix is. Dat zal de betreffende foutmelding wel opleveren.
Jan
"Jan B." <jbronzwaer(dit weglaten)@home.nl> schreef in bericht
news:F18C0127-1D31-4DAA...@microsoft.com...
> frits,
>
> Ik heb de code:
>
> For kol = 1 To 5
> a = a & " " & arr2(n, kol)
> Next
>
> vervangen door:
>
> a = Join(arr2(Cells(n, 4), Cells(n, 5), Cells(n, 6), _
> Cells(n, 7), Cells(n, 8)), " ")
>
> dat geeft in die regel de foutmelding:
> 1004: door toepassing of door object veroorzaakte fout.
>
> enig idee ?
>
> --
> met vriendelijke groet,
> Jan B.
>
>
> "Frits" schreef:
Frits
Ik ben deze discussie vanaf het begin een beetje aan het volgen.
De snelheid verbaast mij.
ik denk toch dat
arr(n, 0) = Join(Array(var1(n, 1), var1(n, 2), var1(n, 3), var1(n,
4),
var1(n, 5)), " ")
een fractie sneller is dan de loop 1 to 5
timer 0,25 <> 0,28 bij 40000 regels.
een vraagje
rng = arr doet bij mij niets
Range("D11:D40000") = arr wel
enig idee waarom?
Weet een van jullie of deze array in een keer geschreven kan worden
naar een csv of txt bestand?
open D:\ for append as #1
print #1, arr
close #1 werkt niet
(per loop-stap wegschrijven timer = 0,375 gaat overigens ook best
snel (sneller dan naar Range("D11:D40000")= 0,48, maar toch....)
gr.
Frits
jan
In je eerste bericht heb je het over een join van ranges (cell(n,3)....).
Daarvan zei ik dat het absoluut niet sneller zou zijn dan de tot dan toe aangedragen
oplossingen.
Nu heb je het over een join van waarden uit een matrix (die vertaalslag had ik
eigenlijk moeten maken).
Wellicht dat dat iets sneller is dan de lus.
Overigens zou het veel sneller zijn dan:
var1(n,1) & " " & var1(n,2) & " " & ......?
De lus en deze laatste constructie ontliepen elkaar nauwelijks.
(mijn meting (stopwatch) was aanmerkelijk minder nauwkeurig dan jouw timer methode,
dus als jij een verschil van 0,03 seconden meet dan neem ik dat graag aan.
rng.Value = arr zal vermoedelijk wel werken, behalve dat rng (op dat moment) dan wel
moet zijn gedefinieerd als
Range("D11:D" & lastrij) en niet als Range("D11:H" & lastrij), want dan worden al
die kolommen gevuld met de matrix.
Met Put kun je wel een hele matrix wegschrijven, maar dat is denk ik niet je
bedoeling.
Jan
Frits
Uiteraard duidelijk ( aangepast Range>Array n.a.v. jouw opmerking)
en zoals ik schrijf een fractie verschil
De 'hele' oplossing van deze discussie levert me enorme tijdwinst op
in een overigens flink andere toepassing.
"put" ga ik proberen
Bedankt
Ernst
waarom gebruik je niet gewoon het beste van Excel?
met
Range("D11:D40000").formular1c1="=RC[1]&"",""&RC[2]&"",""&RC[3]&"",""&RC[4]"
daarna kan je de formules nog omzetten in waarden als je dat wilt.
groeten Ernst
"Jan B." <jbronzwaer(dit weglaten)@home.nl> schreef in bericht
news:D8B68756-F41E-477C...@microsoft.com...
jan
Dat is gewoon goed en inderdaad weer iets sneller dan de snelste oplossing in deze
discussie tot nu toe.
Aangenomen dat kolom C vrij gebruikt mag worden zou dat zoiets kunnen worden:
Sub Combineren5()
Range("C11:C60000").Formula = "=RC[1]&"",""&RC[2]&"",""&RC[3]&"",""&RC[4]"
Range("D11:D60000").Value = Range("C11:C60000").Value
Range("C11:C60000").ClearContents
End Sub
Jan
Ernst
Fijn dat je nu een snellere oplossing hebt.
Veel succes verder.
groeten Ernst Schuurman
"jan" <j...@releerf.nl> schreef in bericht
news:etPupPmp...@TK2MSFTNGP04.phx.gbl...
jan
Jan B. kan er inderdaad wellicht z'n voordeel mee doen.
(grof gemeten verschil ą0,65 s tegenover ą0,8 seconden)
Jan