VBA Autofill importeren data

[Nappie84]

Misschien al ergens gepost maar kon het antwoord/oplossing niet zo snel vinden.

Wie kan mij helpen met het volgende:

Ik importeer 1x per week een csv bestand in een sheet Brondata, welke de kolommen A tm J vullen. In kolom K moet dan handmatig de huidige week worden toegevoegd, bijvoorbeeld wk 19, wk 20 enz.
Handmatig doe ik dit doormiddel van crtl-d en de vulgreep welke de waarde dan in kolom K aanvult tot de laatste regels van kolom A tm J die geïmporteerd zijn.

De VBA code die ik tot nu toe gemaakt hebt vraagt welke week ik wil toevoegen. Als ik "18" op geef, wordt kolom K met 18 aangevuld tot de laatste regels van kolom A tm J die geïmporteerd zijn. Tot zover gaat het goed.

Probleem:
1. Als ik nieuwe data toevoeg in kolom J en wederom de macro start en bijv "19" opgeef dan wordt deze wel gevuld, maar niet met "19" maar met "18". Wat doe ik hier verkeerd en hoe moet de code eruitzien?

2. Als ik i.p.v. "18" "wk 18" opgeef dan wordt niet alles met "wk 18" gevuld, maar met "wk 18", "wk 19", "wk 20" enz. Wat moet hier aangepast worden om dit wel te laten werken?

In de bijlage een voorbeeld bestand met de huidige vba code. Ik kan vanwege de privacy informatie het oorspronkelijke bestand zelf niet posten.

Alvast dank!

 

[Timshel]

Probeer het eens zo:

Sub Knop1_Klikken()
    Dim strname As String
    Dim ws As Worksheet
    Dim LastRowJ As Long, LastRowK As Long
    
    Set ws = Worksheets("Blad1")
    strname = InputBox(prompt:="Geef week en weeknummer op: (wk xx)")
    ws.Range("K" & Rows.Count).End(xlUp).Offset(1).Value = strname
    LastRowJ = Range("J" & Rows.Count).End(xlUp).Row
    LastRowK = Range("K" & Rows.Count).End(xlUp).Row
    If LastRowJ > LastRowK Then Range("K" & LastRowK & ":K" & LastRowJ).FillDown
End Sub

 

[snb]

Sub Knop1_Klikken()
   Blad1.Columns(10).SpecialCells(2).Offset(, 1) = "wk " & InputBox("weeknummer")
End Sub

 

[Nappie84]

Dank voor jullie hulp de macro werkt!

Nu wil ik alleen dat er geen inputbox wordt gebruikt maar een teller. Ik heb de code hiervoor aangepast en het lijkt te werken....
Echter alleen met getallen. Zodra ik er "wk 20" invoer, dan krijg ik een foutmelding: Fout 13 tijdens uitvoering: Typen komen niet met elkaar overeen.
Welke code ben ik vergeten....

Sub Knop2_Klikken()
Dim LastRow As Long
Dim LastRowJ As Long, LastRowK As Long

LastRow = ActiveSheet.Range("K" & Rows.Count).End(xlUp).Row
ActiveSheet.Cells(LastRow + 1, "K").Value = ActiveSheet.Cells(LastRow, "K").Value + 1
LastRowJ = Range("J" & Rows.Count).End(xlUp).Row
LastRowK = Range("K" & Rows.Count).End(xlUp).Row
If LastRowJ > LastRowK Then Range("K" & LastRowK & ":K" & LastRowJ).FillDown

End Sub

 

[Timshel]

Ik denk zo:

Sub Knop2_Klikken()
    Dim LRowJ As Long, LRowK As Long
    Dim Cl As Range

    LRowK = Range("K" & Rows.Count).End(xlUp).Row
    Set Cl = ActiveSheet.Cells(LRowK, "K")
    If InStr(Cl, "wk") > 0 Then
        Cl.AutoFill Cl.Resize(2)
    Else
        Cl.Offset(1) = Cl + 1
    End If
    LRowJ = Range("J" & Rows.Count).End(xlUp).Row
    If LRowJ > LRowK + 1 Then Range("K" & LRowK + 1 & ":K" & LRowJ).FillDown
End Sub

 

[Nappie84]

Timshel, het is gelukt! bedankt voor de hulp.

 

[snb]

Waarom heb je de veel eenvoudiger aanpak van #3 niet geprobeerd ?

 

[Nappie84]

De vba code maakt deel uit van een macro met meerdere code en daarom leek mij het niet handig om er een extra inputbox tussen te plaatsen.

 

[Timshel]

@ snb.
Jouw routine overschrijft reeds gevulde cellen in kolom K.
Ts vroeg om een code die gegevens aanvult in die kolom voor nieuw ingevoerde rijen (probleem 1).

 

[snb]

Lijkt me eenvoudig te verhelpen:

Sub Knop1_Klikken()
   Blad1.Columns(10).SpecialCells(2).Offset(, 1).specialcells(4) = "wk " & InputBox("weeknummer")
End Sub

 

[Timshel]

Nice

 

[Nappie84]

Hoewel ik er een slotje op heb gedaan nog 1 laatste brandende vraag (deze had ik gisteren er bij moeten stellen).

In de kolommen L tm Q worden op basis van de import van A tm J en nu gevuld nu met weeknummers in Kolom K berekeningen gedaan.
De import is wekelijks ongeveer 6000 regels (wat eigenlijk niet meer in Excel thuishoort gezien de performance voor de berekeningen, maar voor the time being).

Wat ik nu handmatig doe is het volgende:
Ik selecteer de laatste regel van L tm Q waar de formules in staan en selecteer ook de eerste volgende (lege) regel. Via Ctrl-D en de vulgreep worden de regels net zoals bij de weeknummer gevuld tot aan de laatste regel van de kolom.

Nu heb ik een formule maar die begint bij de eerste regels van kolom L tm Q te berekeningen tot aan de laatste regel.
Eigenlijk moet deze niet helemaal bovenaan beginnen met rekenen maar vanaf de regel waar de formule voor het laatst aanwezig is tot aan de laatste regel van de kolommen die gevuld zijn.

Ik gebruik VBA niet heel vaak maar wil hem graag zoveel mogelijk automatiseren.....
Ik hoop dat jullie mij vraag begrijpen.

Kunnen jullie mij nog 1 maal helpen?

 

[snb]

6000 regels is voor Excel geen enkel probleem. Tenzij je niet efficiënte formules gebruikt.

 

[Nappie84]

Ik heb het werk van een collega overgenomen die weggaan is, en dit elke week handmatig heeft gedaan.
Helaas mag of kan ik het bronbestand niet een gedeelte vanwege privacy informatie posten....

Maar de formules die gebruikt worden zijn
Kolom L =ALS(ISFOUT(VIND.ALLES("OTA";I66027));"p";"o") voor waarde in kolom I
Kolom M=$M$1&" "&VERT.ZOEKEN(E79895;OIN!A:B;2;ONWAAR) voor waarde in kolom E
Kolom N =$N$1&" "&VERT.ZOEKEN(G79895;OIN!A:B;2;ONWAAR) voor waarde in kolom G
Kolom O=ALS.FOUT(DEEL(I79895;VIND.ALLES("CPA";I79895);4);"niet bekend") voor waarde in kolom I
Kolom P =ALS(J79895>1;1;1) voor waarde in Kolom J
Kolom Q =AANTAL.ALS(B:B;B79895)

 

[Nappie84]

Bekijk bijlage Map1.xlsx

 

[Timshel]

Sub Knop1_Klikken()
    Dim Rn As Range
    Set Rn = Sheet1.Range("K" & Cells(Rows.Count, 11).End(xlUp).Row).Resize(, 7)
    Rn.AutoFill Rn.Resize(2)
    Rn.Offset(1).Resize(Cells(Rows.Count, 10).End(xlUp).Row - Rn.Row).FillDown
End Sub

Ik meen te begrijpen dat een bereik in een of meer formules moet worden aangepast. Ligt dat nog even toe graag.
Kolom P heeft een nogal overbodige formule die altijd 1 als resultaat geeft.

 

[Nappie84]

Zoals in het voorbeeld doe ik het volgende:
Ik selecteer de laatste regel van kolom L tm Q, die begin met P. daarna selecteer ik de volgende lege en via Ctrl-D wordt de formule gekopieerd.
Via de vul functie worden dan alles formules tot de laatste kolom doorgetrokken (Zover als Kolom A tm K gevuld worden met import data.

De macro moet dus de formules en de berekeningen doortrekken naar beneden en niet beginnen bij Kolom L2 tm Q2.

Als ik de Macro uitvoer krijg ik een foutmelding
Ook als ik Sheet1 aanpas naar Brondata zoals het tabblad bij heet krijg ik een foutmelding fout 424 tijden uitvoering, Object vereist
Bij deze regel gaat het fout:

Set Rn = Sheet1.Range("K" & Cells(Rows.Count, 11).End(xlUp).Row).Resize(, 7)

 

[Timshel]

Sub Knop1_Klikken()
    Dim Rn As Range
    Set Rn = [COLOR="#FF0000"]Sheets("Brondata")[/COLOR].Range("K" & Cells(Rows.Count, 11).End(xlUp).Row).Resize(, 7)
    Rn.AutoFill Rn.Resize(2)
    Rn.Offset(1).Resize(Cells(Rows.Count, 10).End(xlUp).Row - Rn.Row).FillDown
End Sub

 

[Nappie84]

Gaat nog niet goed.. als ik de macro uitvoer wordt er in Kolom K wk 19 toegevoegd als ophoging van wk 18. In kolom L tm Q blijven nog leeg
Foutmelding is nu:
"Fout 1004 tijdens uitvoering Door de toepassing of door een object gedefinieerde fout"

Foutmelding komt voor bij
Rn.Offset(1).Resize(Cells(Rows.Count, 10).End(xlUp).Row - Rn.Row).FillDown

 

[Timshel]

Er is verondersteld dat kolom K ook nog aangevuld moet worden.
Als je de aanvulling is kolom K verwijdert en dan de macro draait werkt het waarschijnlijk wel.
Leek me handig om alles in één keer te doen.