Macro die een 0 vervangt door de datum van vandaag (jjjj-mm-dd)

[204roermond]

Ik ben een leek met macro's, maar toch heb ik alles werkend wat ik zou willen op 1 ding na. Ik zou graag een macro willen maken, waarbij de nullen (0) in een kolom worden vervangen door de datum van vandaag (welke op deze manier is geschreven: jjjj-mm-dd). Nu heb ik dit op twee manieren geprobeerd:

1.
- In kolom C de nul vervangen door: =VANDAAG()
- Dan celeigenschappen > Aangepast > Type: jjjj-mm-dd
- Kolom C selecteren en kopiëren
- Plakken speciaal (Waarden) in kolom D
- Kolom D selecteren en dan celeigenschappen > Aangepast > Type: jjjj-mm-dd
- Kolom C weggooien.

Stukje code in de macro:

    Columns("C:C").Select
    Selection.Replace What:="0", Replacement:="=VANDAAG()", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("C:C").Select
    Selection.Cut
    Columns("C:C").Select
    Application.CutCopyMode = False
    Selection.Copy
    Columns("D:D").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("C:C").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Columns("C:C").Select
    Selection.NumberFormat = "yyyy/mm/dd"

2.
- In cel A1 deze formule zetten: =VANDAAG()
- In kolom B de nul vervangen door: = TEKST(A1;"jjjj-mm-dd")

Stukje code in de macro:

    Columns("B:B").Select
    Selection.Replace What:="0", Replacement:="= TEKST(A1;""jjjj-mm-dd"")", _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
        False, ReplaceFormat:=False

Beide pogingen werken als ik het handmatig doe, maar niet als je ze opneemt als macro. Nummer 1 geeft een #NAAM? als resultaat. En nummer 2 laat de nul staan (heeft volgens mij met de dubbele "" te maken, die in de macro staan).

Ik doen ongetwijfeld iets verkeerd, maar heeft iemand een idee hoe ik dit voor elkaar zou kunnen krijgen?

 

[HSV]

Test dit eens.

Sub enne()
With Columns(2)
  .SpecialCells(2).Name = "br"
  [br] = [if(br=0,now(),br)]
  .NumberFormat = "yyyy-mm-dd"
End With
End Sub

 

[204roermond]

Beste Harry,

Bedankt voor je code. Die werkt als ik hem in de poging2.xlsm zet. Maar als ik je stukje code in het origineel zet, dan werkt het niet meer. Kun je me verklappen waar ik je code moet plaatsen in onderstaande code:

Sub Macro1()
'
' Macro1 Macro
'

'
    ActiveWorkbook.Save
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;S:\Internetverkoop\0-documentatie-webshop\Amazon-labels-importeren-in-Delisprint\DPD-tracking-codes-importeren-in-Amazon\Pakketnummers-uit-DelisPrint.csv" _
        , Destination:=Range("$A$1"))
        .Name = "Pakketnummers-uit-DelisPrint"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 _
        , 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 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("B:D").Select
    Selection.Delete Shift:=xlToLeft
    Columns("C:AR").Select
    Selection.Delete Shift:=xlToLeft
    Columns("D:AR").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:CO").Select
    Selection.Delete Shift:=xlToLeft
    Columns("C:C").Select
    Columns("B:B").Select
    ActiveWindow.SmallScroll Down:=-21
    Selection.AutoFilter
    ActiveSheet.Range("$B$1:$B$50").AutoFilter Field:=1, Criteria1:= _
        "<>???-???????-???????", Operator:=xlAnd
    Rows("2:2188").Select
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=-90
    Range("B22").Select
    ActiveSheet.Range("$B$1:$B$21").AutoFilter Field:=1
    ActiveWindow.SmallScroll Down:=-24
    Columns("B:B").Select
    Selection.AutoFilter
    Range("A1").Select
    ActiveWindow.SmallScroll Down:=-18
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "tracking-number"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "order-id"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "ship-date"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "carrier-name"
    Columns("D:D").Select
    Selection.Replace What:="Admin", Replacement:="DPD", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Columns("A:A").Select
    Selection.Cut
    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight
    Columns("B:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "order-item-id"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "quantity"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "carrier-code"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "ship-method"
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("H1").Select
    ActiveWindow.SmallScroll Down:=-15
    Range("A1").Select
    Application.CutCopyMode = False
    ChDir "S:\Internetverkoop\0-documentatie-webshop\Amazon-labels-importeren-in-Delisprint\DPD-tracking-codes-importeren-in-Amazon"
    ActiveWorkbook.SaveAs Filename:= _
        "S:\Internetverkoop\0-documentatie-webshop\Amazon-labels-importeren-in-Delisprint\DPD-tracking-codes-importeren-in-Amazon\" & Format(Now, "dd-mm-yy") & ".txt", FileFormat:=xlText _
        , CreateBackup:=False
End Sub

Ik hoop dat je me hiermee kunt helpen.

 

[HSV]

Dat is een opgenomen code met veel meegekregen rommel.
Dat wordt pluizen wat je van plan bent.

Je kunt in ieder geval beginnen met het plaatsen van het origineel zonder gevoelig info.

 

[204roermond]

Beste Harry,

Zie bijlagen. De CSV is het bestand wat waar Excel zijn ding mee moet doen. Ik heb er fictieve gegevens ingezet.

Ik heb alles stap voor stap doorlopen (middels F8), en het gaat allemaal goed, tot dat hij bij het stukje code van jou komt, daarmee lijkt hij niets te doen. De nullen blijven dan ook gewoon staan, zonder dat deze vervangen worden door de datum van vandaag. Ik hoop dat jij het probleem ziet.

 

[VenA]

Je zoekt in de verkeerde kolom.

With Columns([COLOR="#FF0000"]4[/COLOR])

 

[204roermond]

Het zit 'em soms ik hele kleine dingen i.c.m. onvoldoende kennis op dit gebied, dat blijkt wel weer. VenA en Harry, heel erg bedankt voor jullie hulp en de oplossing! Het werkt nu perfect!:thumb:

 

[VenA]

Ik vind het maar een raar gehussel met kolommen. Als je steeds een dataconnectie maakt met dezelfde bron dan lijkt mij dat een onnodige actie. Waarom importeer je niet alleen de vier kolommen die je nodig hebt? Jouw opgenomen macro heb ik gereduceerd tot

Sub VenA()
  c00 = "E:\Temp\"
  'c00 = S:\Internetverkoop\0-documentatie-webshop\Amazon-labels-importeren-in-Delisprint\DPD-tracking-codes-importeren-in-Amazon\
  With Sheets("Blad1")
    .UsedRange.Clear
    .Columns.NumberFormat = "@"
    With .QueryTables.Add("TEXT;" & c00 & "Pakketnummers-uit-DelisPrint-forum.csv", Range("$A$1"))
      .Name = "Pakketnummers-uit-DelisPrint"
      .TextFileParseType = xlDelimited
      .TextFileSemicolonDelimiter = True
      .TextFileCommaDelimiter = False
      .Refresh BackgroundQuery:=False
    End With
       
    ar = .Cells(1).CurrentRegion
    .Cells(1).CurrentRegion.Clear
    For j = 2 To UBound(ar)
      If ar(j, 5) <> "<>???-???????-???????" Then
        c01 = c01 & " " & j
        If ar(j, 48) = 0 Then ar(j, 48) = Format(Date, "yyyy-mm-dd")
        ar(j, 90) = "DPD"
        ar(j, 1) = "'" & ar(j, 1)
      End If
    Next j
    ar1 = Split(Mid(c01, 2))
    .Cells(2, 1).Resize(UBound(ar1) + 1, 4) = Application.Transpose(Application.Index(ar, ar1, Application.Transpose(Array(5, 48, 90, 1))))
    .Columns("B:C").Insert
    .Columns("E").Insert
    .Cells(1).Resize(, 8) = Split("Kop1 Kop2 Kop3 Kop4 Kop5 Kop6 Kop7 Kop8")
    .Parent.SaveAs c00 & Format(Date, "yyyy-mm-dd") & ".txt", xlText
  End With
End Sub