Invoer van gegevens in een macro

[Evelthoven]

Goedemiddag,

Hieronder een deel van een macro die ik gebruik om gegevens op te halen:

Sub LijstSamenstellenIM()

' 01 Importeren

Application.ScreenUpdating = False
Application.EnableEvents = False

With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;L:\DOS\Productie\2007\20070828.csv", Destination:= _
        Range("B1"))
        .Name = "20070828"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = ";"
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
        Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    
    ' 02 Datum invullen + tabblad een naam geven
    
    Dim c As Variant
Dim lngRow As Long

Sheets(2).Activate
For Each c In Sheets(2).Range("B5", Range("B5").End(xlDown))
    If Left(c, 3) = "MGR" Then
    c.Offset(0, -1).Value = Format(Mid(Range("B2"), 13, 2) & "-" & Mid(Range("B2"), 15, 2) & "-" & Year(Now()), "dd-mm-yyyy")
    End If
Next

ActiveSheet.Name = "IM" & Year(Now()) & Mid(Range("B2"), 13, 4)

Omdat ik dagelijks de gegevens moet ophalen is mijn vraag of het mogelijk is om de data van de op te halen CSV-file in deze macro aan te passen, zodanig dat er na het opstarten van de macro gevraagd wordt naar de datum.
Bijv.: Van welke datum wilt u het CSV-bestand ophalen ?
Dat ik dan de juitste datum kan invullen.
En dat deze datum dan geplaatst wordt achter .....\2007\... en 2 regels verder achter
.Name = " "

Heeft iemand hier een oplossing voor ?

Bedankt,
Eric

 

[Jan van Asseldonk]

Vraag de datum op in een variabele en gebruik deze in de macro.

Sub LijstSamenstellenIM()

' 01 Importeren

Application.ScreenUpdating = False
Application.EnableEvents = False
[B]Dim VraagDatum as String
VraagDatum = Inputbox("Geef gewenste datum in vorm jjjjmmdd ")
[/B] 
With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;L:\DOS\Productie\2007\[B]" & VraagDatum & "[/B].csv", Destination:= _
        Range("B1"))
        .Name = [B]VraagDatum[/B]
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = ";"
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
        Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    
    ' 02 Datum invullen + tabblad een naam geven
    
    Dim c As Variant
Dim lngRow As Long

Sheets(2).Activate
For Each c In Sheets(2).Range("B5", Range("B5").End(xlDown))
    If Left(c, 3) = "MGR" Then
    c.Offset(0, -1).Value = Format(Mid(Range("B2"), 13, 2) & "-" & Mid(Range("B2"), 15, 2) & "-" & Year(Now()), "dd-mm-yyyy")
    End If
Next

ActiveSheet.Name = "IM" & Year(Now()) & Mid(Range("B2"), 13, 4)

Vetgedrukte is toegevoegd c.q. aangepast.
Code is niet getest.

 

[Evelthoven]

Jan en natuurlijk ook anderen,

Deze aanpassing werkt perfect.
Ik heb echter nog een aanvullende vraag:

Een stuk verder in dezelfde macro staat de volgende tekst:

ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(INDEX(Cyclustijd,MATCH(IM20070828!RC5,Matrijsnummer,0))),"""",INDEX(Cyclustijd,MATCH(IM20070828!RC5,Matrijsnummer,0)))"
    Selection.Copy
    Range("G2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(INDEX(Caviteit,MATCH(IM20070828!RC5,Matrijsnummer,0))),"""",INDEX(Caviteit,MATCH(IM20070828!RC5,Matrijsnummer,0)))"

Zoals je ziet staat er ook nog 4 keer de datum in, nl. IM20070828! Graag zou ik op deze plaatsen ook weer de VRAAGDATUM terug zien komen, anders moet ik deze iedere keer handmatig aanpassen. Ik denk dat dit wel mogelijk is, alleen ik weet niet hoe precies.

Ik heb het volgende geprobeerd maar dit werkt niet:

...Match("IM & VraagDatum &")!........

Iemand enig idee ?

Bedankt,
Eric

 

[Wigi]

In essentie is de code van die formule gewoon tekst. Niets meer, niets minder. 1 hele lange string.

Daar waar dus het variabele deel moet ingepast worden, knip je de tekst open en voeg je dat deel tussen.

Je knipt dat open door de string af te sluiten met " daar waar je iets wil tussenvoegen. Dan dat tussenvoegen en terug beginnen met een " (aangezien er weer tekst komt).

Wigi

 

[Evelthoven]

Wigi,

Volgens jouw uitleg heb ik nu bij de 4 plaatsen waar dit moet komen te staan alsvolgt:

.....match(IM"VraagDatum")!RC5.........

maar dan krijg ik de melding ' compileerfout: verwacht: einde instructie'

Wat heb ik niet goed gedaan ?

 

[Wigi]

De ampersand & is de lijm die de stukken terug aan elkaar plakt.

ActiveCell.FormulaR1C1 = "=IF(ISERROR(INDEX(Cyclustijd,MATCH(IM" & VraagDatum & "!RC5..."

Wigi

 

[Evelthoven]

Wigi,

Bedankt, opgelost.