[Excel 2013] Macro / VBA vraag celwaarde aanpassen

[TrueGamer]

Mijn vraag
Hoe kan ik een macro maken die voor mij de waarde van een kolom aanpast?

Uitleg
Het betreft een periodewaarde uit een budget (1 tm 12) die ik wil veranderen in (B1 tm B12).
Dus vanaf bijvoorbeeld kolom B alle waarden waarin een getal zit de letter B ervoor zetten.

Relevante software en hardware die ik gebruik
AFAS Profit
Microsoft Excel 2013

Zit al een tijdje online te zoeken naar hoe dit moet maar krijg het niet werkend nog.
Hopelijk is mijn vraag duidelijk.

Alvast bedankt voor jullie hulp

[Nat-Water]

Geen idee hoe de rest van je spreadsheet eruit ziet, maar je hebt niet eens per se een macro nodig. Een simpele formule zoals =tekst.samenvoegen("B";A1) zet er al een B voor.

[TrueGamer]

Probleem is dat die hem automatisch moet overschrijven.
De waarde moeten dus in die Kolom B blijven enkel toevoeging van B1 ipv 1 etc.

Dit omdat er een dezelfde spreadsheet uitkomt met daaronder de werkelijke cijfers die ik vervolgens weer onder elkaar laat plakken met een macro om op een soort master spreadsheet uit te komen.

Waarna ik een draaitabel op deze data loslaat.

En hij nu dus onterecht de begrote cijfers samenbrengt omdat hij de periode niet kan onderscheiden.

[breew]

Voor vba is dit een appeltje-eitje...

Ik heb voldoende commentaar bij de code gezet, om te kunnen snappen wat er gebeurt (hoop ik). Aanpassen naar eigen wens.

Visual Basic:

Option Explicit

Sub ZetErEenBVoor()

  'declaratie
  Dim lonLaatsteRij As Long   'het rijnummer van de onderste rij met data in kolom B
  Dim rng As Range            'het bereik vanaf B2 tot de onderste cel met data in kolom B
  Dim cel As Range            'een cel in het bereik "rng"
  
  'initialisatie
  'met het actieve werkblad
  With ActiveSheet
    'bepaal de onderste rij in kolom B die nog data bevat
    lonLaatsteRij = .Cells(Rows.Count, 2).End(xlUp).Row
    'stel het bedeil in vanaf cel 2,2 (B2) tot aan de cel in kolom B(2) met het rijnummer van lonLaatsteRij
    Set rng = .Range(.Cells(2, 2), .Cells(lonLaatsteRij, 2))
  End With
  
  'loop nu door elke cel in het bereik rng
  For Each cel In rng
    'als de celwaarde numeriek is, plak er dan een 'B' voor
    If IsNumeric(cel.Value) Then cel.Value = "B" & cel.Value
  Next cel

'KLAAR

End Sub

[F_J_K]

Op de wenken bediend

Het is inderdaad simpele VBA, ook daarom de tip: NIET gebruiken zonder eerst te leren wat het doet. En altijd een backup maken. Bovenstaande is prima, maar in het algemeen is 'blind' ergens van het web overnemen levensgevaarlijk. Aangezien je eigenlijk alleen de basics nodig hebt, zou ik adviseren een paar tutorials door te nemen. Ga niet op zoek naar een kant-en-klaar script of -functie, maar naar de onderliggende kennis. En die is zat ook gratis te vinden.

Er zit overigens nog een foutje in de code, lege cellen worden ook herkend als numeriek. Dat kan je natuurlijk met een tweede check oplossen, met IsEmpty(cel).

Overweeg ook het niet gebruiken van ActiveSheet, maar zelf aanduiden welke sheet moet worden gebruikt: dat maakt het nog wat minder foutgevoelig.

[breew]

F_J_K schreef op dinsdag 7 november 2017 @ 13:39:
Op de wenken bedient

Het is inderdaad simpele VBA, ook daarom de tip: NIET gebruiken zonder eerst te leren wat het doet. En altijd een backup maken. Bovenstaande is prima, maar in het algemeen is 'blind' ergens van het web overnemen levensgevaarlijk. Aangezien je eigenlijk alleen de basics nodig hebt, zou ik adviseren een paar tutorials door te nemen. Ga niet op zoek naar een kant-en-klaar script of -functie, maar naar de onderliggende kennis. En die is zat ook gratis te vinden.

Er zit overigens nog een foutje in de code, lege cellen worden ook herkend als numeriek. Dat kan je natuurlijk met een tweede check oplossen, met IsEmpty(cel).

Overweeg ook het niet gebruiken van ActiveSheet, maar zelf aanduiden welke sheet moet worden gebruikt: dat maakt het nog wat minder foutgevoelig.

Oh ja , vergeten de lege cellen mee te nemen... het wordt nog leuker als de cellen die deels numeriek zijn, ook meegenomen moeten worden (nu we toch aan het spelen zijn).

Visual Basic:

Option Explicit

Sub ZetErEenBVoor()

  'declaratie
  Dim lonLaatsteRij As Long   'het rijnummer van de onderste rij met data in kolom B
  Dim rng As Range            'het bereik vanaf B2 tot de onderste cel met data in kolom B
  Dim cel As Range            'een cel in het bereik "rng"
  Dim i As Integer
  
  'initialisatie
  'met het actieve werkblad
  With ActiveSheet
    'bepaal de onderste rij in kolom B die nog data bevat
    lonLaatsteRij = .Cells(Rows.Count, 2).End(xlUp).Row
    'stel het bedeil in vanaf cel 2,2 (B2) tot aan de cel in kolom B(2) met het rijnummer van lonLaatsteRij
    Set rng = .Range(.Cells(2, 2), .Cells(lonLaatsteRij, 2))
  End With
  
  'loop nu door elke cel in het bereik rng
  For Each cel In rng
    'als de celwaarde numeriek is, plak er dan een 'B' voor
    If Not IsEmpty(cel.Value) Then
      If IsNumeric(cel.Value) Then
        cel.Value = "B" & cel.Value
      Else
        For i = 1 To Len(cel.Value)
            If Mid(cel.Value, i, 1) >= "0" And Mid(cel.Value, i, 1) <= "9" Then
                cel.Value = "B" & cel.Value
                Exit For
            End If
        Next i
      End If
    End If
  Next cel

'KLAAR

End Sub

[TrueGamer]

breew schreef op dinsdag 7 november 2017 @ 13:45:
[...]


Oh ja , vergeten de lege cellen mee te nemen... het wordt nog leuker als de cellen die deels numeriek zijn, ook meegenomen moeten worden (nu we toch aan het spelen zijn).

Visual Basic:

Option Explicit

Sub ZetErEenBVoor()

  'declaratie
  Dim lonLaatsteRij As Long   'het rijnummer van de onderste rij met data in kolom B
  Dim rng As Range            'het bereik vanaf B2 tot de onderste cel met data in kolom B
  Dim cel As Range            'een cel in het bereik "rng"
  Dim i As Integer
  
  'initialisatie
  'met het actieve werkblad
  With ActiveSheet
    'bepaal de onderste rij in kolom B die nog data bevat
    lonLaatsteRij = .Cells(Rows.Count, 2).End(xlUp).Row
    'stel het bedeil in vanaf cel 2,2 (B2) tot aan de cel in kolom B(2) met het rijnummer van lonLaatsteRij
    Set rng = .Range(.Cells(2, 2), .Cells(lonLaatsteRij, 2))
  End With
  
  'loop nu door elke cel in het bereik rng
  For Each cel In rng
    'als de celwaarde numeriek is, plak er dan een 'B' voor
    If Not IsEmpty(cel.Value) Then
      If IsNumeric(cel.Value) Then
        cel.Value = "B" & cel.Value
      Else
        For i = 1 To Len(cel.Value)
            If Mid(cel.Value, i, 1) >= "0" And Mid(cel.Value, i, 1) <= "9" Then
                cel.Value = "B" & cel.Value
                Exit For
            End If
        Next i
      End If
    End If
  Next cel

'KLAAR

End Sub

Many thanks!!
Dit is precies wat ik zocht

F_J_K schreef op dinsdag 7 november 2017 @ 13:39:

Overweeg ook het niet gebruiken van ActiveSheet, maar zelf aanduiden welke sheet moet worden gebruikt: dat maakt het nog wat minder foutgevoelig.

Maar eens kijken hoe ik dat voor elkaar krijg haha

[breew]

TrueGamer schreef op dinsdag 7 november 2017 @ 14:20:
[...]


Many thanks!!
Dit is precies wat ik zocht


[...]


Maar eens kijken hoe ik dat voor elkaar krijg haha

ActiveSheet is een makkelijke manier om het actieve werkblad te gebruiken.. Het gevaar er van is dat, als je de macro start terwijl je in een andere sheet aan het werk bent, ineens de hele kolom B van die sheet overhoop gooit.
En VBA heeft geen ctrl-z; die overschreven data ben je dan dus 'kwijt' (been there, done that...)

Het is netter/beter/verstandiger om te verwijzen naar een sheet middels

code:

Activewokbook.Sheets(1)

het eerste werkblad in het werkboek, of met

code:

Activeworkbook.Sheets("Weetikveel")

, het werkblad met de naam "Weetikveel"

[TrueGamer]

breew schreef op dinsdag 7 november 2017 @ 15:56:
[...]


ActiveSheet is een makkelijke manier om het actieve werkblad te gebruiken.. Het gevaar er van is dat, als je de macro start terwijl je in een andere sheet aan het werk bent, ineens de hele kolom B van die sheet overhoop gooit.
En VBA heeft geen ctrl-z; die overschreven data ben je dan dus 'kwijt' (been there, done that...)

Het is netter/beter/verstandiger om te verwijzen naar een sheet middels

code:

Activewokbook.Sheets(1)

het eerste werkblad in het werkboek, of met

code:

Activeworkbook.Sheets("Weetikveel")

, het werkblad met de naam "Weetikveel"

Thanks!

De code Activeworkbook.Sheets("Weetikveel") werkt perfect.

Het duurt alleen redelijk lang voordat de macro is uitgevoerd +- 6 min.
Is dat normaal voor een kleine 26.000 rijen of valt her en der nog wat te tweaken?

[breew]

TrueGamer schreef op woensdag 8 november 2017 @ 11:47:
[...]


Thanks!

De code Activeworkbook.Sheets("Weetikveel") werkt perfect.

Het duurt alleen redelijk lang voordat de macro is uitgevoerd +- 6 min.
Is dat normaal voor een kleine 26.000 rijen of valt her en der nog wat te tweaken?

Ik vind 6 minuten erg lang...

Er valt natuurlijk altijd wat te tweaken
De vraag is of het tijd die je in het tweaken stopt, zich terugverdient in de tijdsbesparing in de uitvoer..

Maar als je wilt tweaken "omdat het kan", dan moet je dat zeker niet nalaten.

Zo zou je, bijvoorbeeld, op voorhand alvast kunnen filteren (met een autofilter) op lege rijen.. die rijen kun je dan al uitsluiten in de selecte waar doorheen 'geloopt' moet worden.

[TrueGamer]

breew schreef op woensdag 8 november 2017 @ 11:52:
[...]

Ik vind 6 minuten erg lang...

Er valt natuurlijk altijd wat te tweaken
De vraag is of het tijd die je in het tweaken stopt, zich terugverdient in de tijdsbesparing in de uitvoer..

Maar als je wilt tweaken "omdat het kan", dan moet je dat zeker niet nalaten.

Zo zou je, bijvoorbeeld, op voorhand alvast kunnen filteren (met een autofilter) op lege rijen.. die rijen kun je dan al uitsluiten in de selecte waar doorheen 'geloopt' moet worden.

Het is eigenlijk zo dat er zijn geen lege cellen in B2 tm B26000.
In deze kolommen is de waarde tussen 1-12 en het enige wat hoeft te gebeuren is de letter B ervoor.
Dit zodat de waarde niet cumulatief worden meegenomen in de draaitabel.

[breew]

Overal moet een B voor? Dus geen checks of de waarde numeriek is, etc..?

[TrueGamer]

breew schreef op woensdag 8 november 2017 @ 11:56:
Overal moet een B voor? Dus geen checks of de waarde numeriek is, etc..?

Nee hoeft eigenlijk geen enkel check op..
Alleen regel B1 overslaan omdat daar de header staat.

[breew]

Dan is dit volgens mij de snelste oplossing. zou echt geen minuten mogen duren..

Ik heb ook nog even wat systeemwaarden uitgezet tijdens uitvoeren van de code (scherm updaten en herberekenen), dat zou ook uit moeten maken, zeker in grote bestanden met veel formules.

Visual Basic:

Option Explicit

Sub ZetErEenBVoor()

   'we gaan de het scherm niet verversen tijdens het uitvoeren van de macro
   Application.ScreenUpdating = False
   'ook gaan we de sheet niet herberekenen tijdens het uitvoeren van de data
   Application.Calculation = xlCalculationManual

  'declaratie
  Dim lonLaatsteRij As Long   'het rijnummer van de onderste rij met data in kolom B
  Dim rng As Range            'het bereik vanaf B2 tot de onderste cel met data in kolom B
  Dim cel As Range            'een cel in het bereik "rng"
  
  'initialisatie
  'met het werkblad Weetikveel
  With Activeworkbook.sheets("Weetikveel")
    'bepaal de onderste rij in kolom B die nog data bevat
    lonLaatsteRij = .Cells(Rows.Count, 2).End(xlUp).Row
    'stel het bedeil in vanaf cel 2,2 (B2) tot aan de cel in kolom B(2) met het rijnummer van lonLaatsteRij
    Set rng = .Range(.Cells(2, 2), .Cells(lonLaatsteRij, 2))
  End With
  
  'loop nu door elke cel in het bereik rng
  For Each cel In rng
    'plak er dan een 'B' voor
    cel.Value = "B" & cel.Value
  Next cel

  'even alle systeemwaarden weer terugzetten
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic

'KLAAR

End Sub

[Lustucru]

Als we toch gaan optimaliseren: bereik inlezen in een array en array terugschrijven.

Hoewel het in dit geval extreem weinig uitmaakt. 100.000 rijen bijwerken op een vrij oude machine in 11,68 sec met for.each of 0,41 sec met een array copy-paste operatie.

Het duurt alleen redelijk lang voordat de macro is uitgevoerd +- 6 min.
Is dat normaal voor een kleine 26.000 rijen of valt her en der nog wat te tweaken?

Als na iedere wijziging de draaitabel herberekend wordt is het normaal, anders niet.

[ Voor 84% gewijzigd door Lustucru op 08-11-2017 13:44 . Reden: er zat een foutje in de testcode ]

[breew]

Lustucru schreef op woensdag 8 november 2017 @ 12:48:
Als we toch gaan optimaliseren: bereik inlezen in een array en array terugschrijven.

Hoewel het in dit geval extreem weinig uitmaakt. 100.000 rijen bijwerken op een vrij oude machine in 0,43 sec met for.each of 0,41 sec met een array copy-paste operatie.

yup.. is ook een leuke.. het maakt de code vaal wek iets langer en minder leesbaar (in eerste instantie).. Maar voor echt veel data kan het best veel schelen inderdaad (al loop je dan ook vaak weer tegen de rijlimiet van excel aan, dus daar gebruik i tegenwoordig liever R voor.)

Als na iedere wijziging de draaitabel herberekend wordt is het normaal, anders niet.

true.. dat zou dus in deze code ondervangen moeten zijn, door het tijdelijk uitschakelen van de automatische hercalculatie.

Ik ben benieuwd of het uitmaakt, @TrueGamer.

[Lustucru]

breew schreef op woensdag 8 november 2017 @ 13:30:
[...]

yup.. is ook een leuke.. het maakt de code vaal wek iets langer en minder leesbaar (in eerste instantie)..

Dat is dan wel een heel klein 'ietsje'. Eén regel:

Visual Basic:

Set range = sheets[range]
for each c in range
      'doe je ding met c
Next c

vs

array=sheets[range]
for each e in array
     'doe je ding met e
next e

sheets[range]=array

Maar wel 20 tot 25x sneller.

[ Voor 21% gewijzigd door Lustucru op 08-11-2017 13:53 ]

[breew]

Lustucru schreef op woensdag 8 november 2017 @ 13:49:
[...]


Dat is dan wel een heel klein 'ietsje'. Eén regel:

Visual Basic:

Set range = sheets[range]
for each c in range
      'doe je ding met c
Next c

vs

array=sheets[range]
for each e in array
     'doe je ding met e
next e

sheets[range]=array

Maar wel 20 tot 25x sneller.

oh cool ik dacht dat je dan met Ubound() en het (her)dimensioneren van arrays enzo aan de slag moest gaan.. Mooie tip! Ik ga 'em onthouden!

[TrueGamer]

breew schreef op woensdag 8 november 2017 @ 13:30:
[...]

Ik ben benieuwd of het uitmaakt, @TrueGamer.

Iets sneller, schat 2 min.

Dus ben nog even aan het kijken waar het aan ligt..

Gekke gedachten zou het de PC kunnen zijn? Workstation

[breew]

TrueGamer schreef op donderdag 9 november 2017 @ 16:41:
[...]


Iets sneller, schat 2 min.

Dus ben nog even aan het kijken waar het aan ligt..

Gekke gedachten zou het de PC kunnen zijn? Workstation

Kun je het bestand delen? Mag ook via Dm, dan test ik het hier even.

[TrueGamer]

breew schreef op donderdag 9 november 2017 @ 17:43:
[...]


Kun je het bestand delen? Mag ook via Dm, dan test ik het hier even.

Ben bang dat het lastig wordt staan namelijk allemaal bedrijfsgegevens in..
Kan kijken of ik een dummy bestand kan maken wat erop lijkt.

Lustucru schreef op woensdag 8 november 2017 @ 13:49:
[...]


Dat is dan wel een heel klein 'ietsje'. Eén regel:

Visual Basic:

Set range = sheets[range]
for each c in range
      'doe je ding met c
Next c

vs

array=sheets[range]
for each e in array
     'doe je ding met e
next e

sheets[range]=array

Maar wel 20 tot 25x sneller.

Al krijg ik deze code er niet in verwerkt..

[ Voor 42% gewijzigd door TrueGamer op 10-11-2017 08:53 ]

[breew]

Zoals @Lustucru al zei, is het gebruik van arrays wel sneller (en je moet het ookzeker eens proberen!), maar maakt het in dit geval niet ontzettend veel uit qua performance-winst, omdat het al een vrij simpele operatie is.

@TrueGamer: Bij mij duurt het uitvoeren van de code uit deze post ongeveer 5 seconden voor het toevoegen van een B aan 360.000 rijen. Ik heb een systeem uit 2012 (i5 4670, met 16GB RAM)... Dat het bij jou minuten duurt, lijkt me niet normaal...

Gebruik jij dezelfde code?
Probeer eens kolom B te kopiëren naar een leeg werkblad, en draai dan de macro.... Kijken of dat het verschil maakt.

[ Voor 39% gewijzigd door breew op 10-11-2017 09:01 ]

[TrueGamer]

breew schreef op vrijdag 10 november 2017 @ 08:57:
Zoals @Lustucru al zei, is het gebruik van arrays wel sneller (en je moet het ookzeker eens proberen!), maar maakt het in dit geval niet ontzettend veel uit qua performance-winst, omdat het al een vrij simpele operatie is.

@TrueGamer: Bij mij duurt het uitvoeren van de code uit deze post ongeveer 5 seconden voor het toevoegen van een B aan 360.000 rijen. Ik heb een systeem uit 2012 (i5 4670, met 16GB RAM)... Dat het bij jou minuten duurt, lijkt me niet normaal...

Gebruik jij dezelfde code?
Probeer eens kolom B te kopiëren naar een leeg werkblad, en draai dan de macro.... Kijken of dat het verschil maakt.

In een leeg werkblad uit hetzelfde bestand duurt het idd maar een paar seconde.

[breew]

TrueGamer schreef op vrijdag 10 november 2017 @ 09:08:
[...]


In een leeg werkblad uit hetzelfde bestand duurt het idd maar een paar seconde.

Ok, dan is de tijdelijke work-around een copy-paste actie

Blijkbaar worden in je huidige sheet op de achtergrond, tijdens het uitvoeren van de code, allemaal zaken gerefresht / herberekend. Daardoor duurt het allemaal zo lang...

Heb je draaitabellen in je werkboek staan? Als je wijzigingen in het bereik van een draaitabel maakt, gaat 'ie zichzelf steeds verversen.
Je kunt dan 2 dingen doen:

1. het automatisch bijwerken van de draaitabel tijdelijk pauzeren (middels vba code)
2. het implementeren van de code van @Lustucru. deze schrijft het aangepaste resultaat in 1x weg (in plaats van cel-na-cel), waardoor de draaitabel zichzelf maar één keer hoeft te verversen.

[ Voor 30% gewijzigd door breew op 10-11-2017 09:26 ]

[TrueGamer]

breew schreef op vrijdag 10 november 2017 @ 09:16:
[...]


Ok, dan is de tijdelijke work-around een copy-paste actie

Blijkbara worden in je huidige sheet op de achtergrond, tijdens het uitvoeren van de code, allemaal zaken gerefreshed/herberekend. Daardoor duurt het allemaal zo lang...

Heb je draaitabellen in je werkboek staan?

Jaa dat wel maar die prikt weer op een ander tabblad..

[breew]

TrueGamer schreef op vrijdag 10 november 2017 @ 09:26:
[...]


Jaa dat wel maar die prikt weer op een ander tabblad..

Test het maar eens door in een kopie van het bestand de draaitabel weg te knikkeren en de code nogmaals te draaien.. Snel klaar? Dan lag het aan de draaitabel

[TrueGamer]

breew schreef op vrijdag 10 november 2017 @ 09:31:
[...]

Test het maar eens door in een kopie van het bestand de draaitabel weg te knikkeren en de code nogmaals te draaien.. Snel klaar? Dan lag het aan de draaitabel

Ligt dus aan de draaitabel..
Manier om daar omheen te werken zonder deze te verwijderen?

[breew]

TrueGamer schreef op vrijdag 10 november 2017 @ 09:49:
[...]


Ligt dus aan de draaitabel..
Manier om daar omheen te werken zonder deze te verwijderen?

Ik heb de tip van @Lustucru verwerkt in onderstaande code. Probeer die eens?

Visual Basic:

Option Explicit

Sub ZetErEenBVoor()

  'we gaan de het scherm niet verversen tijdens het uitvoeren van de macro
  Application.ScreenUpdating = False
  'ook gaan we de sheet niet herberekenen tijdens het uitvoeren van de data
  Application.Calculation = xlCalculationManual
  'ook even de events uitzetten
  Application.EnableEvents = False

  'declaratie
  Dim lonLaatsteRij As Long   'het rijnummer van de onderste rij met data in kolom B
  Dim rng As Range            'het bereik vanaf B2 tot de onderste cel met data in kolom B
  Dim arrOud() As Variant     'array met de huidige waarden uit kolom B
  Dim arrNieuw() As Variant   'array met de nieuwe waarden uit kolom B
  Dim i As Long               'een lusteller
  
  'initialisatie
  'met het werkblad "Blad1"
  With ActiveWorkbook.Sheets("Blad1")
    'bepaal de onderste rij in kolom B die nog data bevat
    lonLaatsteRij = .Cells(Rows.Count, 2).End(xlUp).Row
    'stel het bedeil in vanaf cel 2,2 (B2) tot aan de cel in kolom B(2) met het rijnummer van lonLaatsteRij
    Set rng = .Range(.Cells(2, 2), .Cells(lonLaatsteRij, 2))
  End With
  
  'geef de waarden uit het bereik 'rng' door aan een array.
  'let op, dit wordt automatisch een tweedimensionale!! array
  arrOud = rng
  'dimendsioneer nu een array voor de nieuwe waarden.
  'deze heeft dezelfde afmetingen als de eerste dimensie van de array met huidige waarden
  ReDim arrNieuw(1 To UBound(arrOud, 1), 1 To 1)
  'loop nu door de eerste dimensie van de array met huidige waarden
  For i = LBound(arrOud, 1) To UBound(arrOud, 1)
    'zet de huidige waarde (een variant) om naar een String (met Cstr() ), en plak er een 'B' voor
    arrNieuw(i, 1) = "B" & CStr(arrOud(i, 1))
  Next i
  
  'schrijf de array met nieuwe aarden weg naar het bereik.
  rng.Value = arrNieuw

  'even alle systeemwaarden weer terugzetten
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
  Application.EnableEvents = True

'KLAAR

End Sub

In het kort, zonder commentaar

Visual Basic:

Option Explicit

Sub ZetErEenBVoor()

Dim lonLaatsteRij As Long, rng As Range, arrOud() As Variant, arrNieuw() As Variant, i As Long

With Application
  .ScreenUpdating = False
  .Calculation = xlCalculationManual
  .EnableEvents = False
End With

With ActiveWorkbook.Sheets("Blad1")
  lonLaatsteRij = .Cells(Rows.Count, 2).End(xlUp).Row
  Set rng = .Range(.Cells(2, 2), .Cells(lonLaatsteRij, 2))
End With

arrOud = rng
ReDim arrNieuw(1 To UBound(arrOud, 1), 1 To 1)

For i = LBound(arrOud, 1) To UBound(arrOud, 1)
  arrNieuw(i, 1) = "B" & CStr(arrOud(i, 1))
Next i

rng.Value = arrNieuw

With Application
  .ScreenUpdating = True
  .Calculation = xlCalculationAutomatic
  .EnableEvents = True
End With

End Sub

[ Voor 16% gewijzigd door breew op 10-11-2017 12:16 . Reden: kleine update in de code ]

[TrueGamer]

breew schreef op vrijdag 10 november 2017 @ 11:34:
[...]


Ik heb de tip van @Lustucru verwerkt in onderstaande code. Probeer die eens?

Visual Basic:

Option Explicit

Sub ZetErEenBVoor()

  'we gaan de het scherm niet verversen tijdens het uitvoeren van de macro
  Application.ScreenUpdating = False
  'ook gaan we de sheet niet herberekenen tijdens het uitvoeren van de data
  Application.Calculation = xlCalculationManual
  'ook even de events uitzetten
  Application.EnableEvents = False

  'declaratie
  Dim lonLaatsteRij As Long   'het rijnummer van de onderste rij met data in kolom B
  Dim rng As Range            'het bereik vanaf B2 tot de onderste cel met data in kolom B
  Dim arrOud() As Variant     'array met de huidige waarden uit kolom B
  Dim arrNieuw() As Variant   'array met de nieuwe waarden uit kolom B
  Dim i As Long               'een lusteller
  
  'initialisatie
  'met het werkblad "Blad1"
  With ActiveWorkbook.Sheets("Blad1")
    'bepaal de onderste rij in kolom B die nog data bevat
    lonLaatsteRij = .Cells(Rows.Count, 2).End(xlUp).Row
    'stel het bedeil in vanaf cel 2,2 (B2) tot aan de cel in kolom B(2) met het rijnummer van lonLaatsteRij
    Set rng = .Range(.Cells(2, 2), .Cells(lonLaatsteRij, 2))
  End With
  
  'geef de waarden uit het bereik 'rng' door aan een array.
  'let op, dit wordt automatisch een tweedimensionale!! array
  arrOud = rng
  'dimendsioneer nu een array voor de nieuwe waarden.
  'deze heeft dezelfde afmetingen als de eerste dimensie van de array met huidige waarden
  ReDim arrNieuw(1 To UBound(arrOud, 1), 1 To 1)
  'loop nu door de eerste dimensie van de array met huidige waarden
  For i = LBound(arrOud, 1) To UBound(arrOud, 1)
    'zet de huidige waarde (een variant) om naar een String (met Cstr() ), en plak er een 'B' voor
    arrNieuw(i, 1) = "B" & CStr(arrOud(i, 1))
  Next i
  
  'schrijf de array met nieuwe aarden weg naar het bereik.
  rng.Value = arrNieuw

  'even alle systeemwaarden weer terugzetten
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
  Application.EnableEvents = True

'KLAAR

End Sub

In het kort, zonder commentaar

Visual Basic:

Option Explicit

Sub ZetErEenBVoor()

Dim lonLaatsteRij As Long, rng As Range, arrOud() As Variant, arrNieuw() As Variant, i As Long

With Application
  .ScreenUpdating = False
  .Calculation = xlCalculationManual
  .EnableEvents = False
End With

With ActiveWorkbook.Sheets("Blad1")
  lonLaatsteRij = .Cells(Rows.Count, 2).End(xlUp).Row
  Set rng = .Range(.Cells(2, 2), .Cells(lonLaatsteRij, 2))
End With

arrOud = rng
ReDim arrNieuw(1 To UBound(arrOud, 1), 1 To 1)

For i = LBound(arrOud, 1) To UBound(arrOud, 1)
  arrNieuw(i, 1) = "B" & CStr(arrOud(i, 1))
Next i

rng.Value = arrNieuw

With Application
  .ScreenUpdating = True
  .Calculation = xlCalculationAutomatic
  .EnableEvents = True
End With

End Sub

Hoppa dit was hem, werkt nu als een tierelier

Echt super bedankt!

[breew]

TrueGamer schreef op maandag 13 november 2017 @ 15:44:
[...]


Hoppa dit was hem, werkt nu als een tierelier

Echt super bedankt!

top! graag gedaan.

note to self: meer met arrays werken ;-)

[TrueGamer]

breew schreef op maandag 13 november 2017 @ 21:10:
[...]


top! graag gedaan.

note to self: meer met arrays werken ;-)

Nu wel een volgend probleem..
Hij pakt nu mijn macro voor het automatisch samenvoegen van tabblad Realisatie_input en Begroting_input niet meer.

code:

Sub Totaal()
    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim shLast As Long
    Dim CopyRng As Range
    Dim StartRow As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Delete the sheet "Totaal" if it exist
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("Totaal").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    'Add a worksheet with the name "Totaal"
    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "Totaal"

    'Fill in the start row
    StartRow = 2

    'loop through all worksheets and copy the data to the DestSh
    For Each sh In ActiveWorkbook.Worksheets

        'Loop through all worksheets except the RDBMerge worksheet and the
        'Information worksheet, you can ad more sheets to the array if you want.
        If IsError(Application.Match(sh.Name, _
                                     Array(DestSh.Name, "Analyse_tool"), 0)) Then
                                     
        'Copy header row, change the range if you use more columns
        If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
            sh.Range("A1:Z1").Copy DestSh.Range("A1")
        End If

            'Find the last row with data on the DestSh and sh
            Last = LastRow(DestSh)
            shLast = LastRow(sh)

            'If sh is not empty and if the last row >= StartRow copy the CopyRng
            If shLast > 0 And shLast >= StartRow Then

                'Set the range that you want to copy
                Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))

                'Test if there enough rows in the DestSh to copy all the data
                If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                    MsgBox "There are not enough rows in the Destsh"
                    GoTo ExitTheSub
                End If

                'This example copies values/formats, if you only want to copy the
                'values or want to copy everything look below example 1 on this page
                CopyRng.Copy
                With DestSh.Cells(Last + 1, "A")
                    .PasteSpecial xlPasteValues
                    .PasteSpecial xlPasteFormats
                    Application.CutCopyMode = False
                End With

            End If

        End If
    Next

ExitTheSub:

    Application.GoTo DestSh.Cells(1)

    'AutoFit the column width in the DestSh sheet
    DestSh.Columns.AutoFit

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Het gekke is als ik dezelfde macro in een ander werkblad heb en hem via het lint uitvoer in het bestand waar ik mee werk hij het wel doet? Ook de code kopiëren werkt niet..

Update:

Onderstaande code / functie vergeten toe te voegen

code:

Option Explicit

'Common Functions required for all routines:

Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(what:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function


Function LastCol(sh As Worksheet)
    On Error Resume Next
    LastCol = sh.Cells.Find(what:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
    On Error GoTo 0
End Function

[ Voor 14% gewijzigd door TrueGamer op 14-11-2017 14:13 ]

[breew]

Lijkt me een mooi lesje voor debuggen van vba-code...
Voeg eens wat breakpoints toe, en kijk dan welke waarden aan de variabelen wordt gegeven (beeld -> venster lokale variabelen)