通过VBA在EXCEL中粘贴公式

Paste formula in EXCEL through VBA

提问人:Thom Haasert 提问时间:10/5/2023 更新时间:10/5/2023 访问量:47

问:

我在EXCEL中创建了以下VBA:

这些公式将字段(例如 J 列中的 2022072610:22:40)转换为:

K列 --> 26-07-2022 (dd-mm-yyyy)

列 L --> 10:22:40 (“[$-x-systime]h:mm:ss AM/PM”)

Sub ABCD_DV_ORDCOLF1_FACTURATIE()
Dim BKWERK1 As Workbook
Dim BKWERK2 As Workbook
Dim Filepath As String
    Dim eindTijd As Double
    eindTijd = Now + TimeValue("00:00:05")
    Application.Wait eindTijd

Set BKWERK1 = ActiveWorkbook

Filepath = "\\holwerda-dc01\Data\users\DC Holwerda, Almere\Logistieke accounts\AA. Logistiek Thom\Data analyse 2022\Keukens Analyse\Dura Vermeer\Check Factuur\DATA\RAW\DATA_FACTUUR-ORDCOLF1.DBF"
            'F:\users\DC Holwerda, Almere\Logistieke accounts\AA. Logistiek Thom\Data analyse 2022\Keukens Analyse\Dura Vermeer\Check Factuur\DATA\RAW\DATA_FACTUUR-ORDCOLF1.DBF
           'F:\users\DC Holwerda, Almere\Logistieke accounts\AA. Logistiek Thom\Data analyse 2022\Keukens Analyse\Dura Vermeer ABCD-procedure\COPY-MAGHISF0\DATA_FACTUUR-ORDCOLF1.DBF

Set BKWERK2 = Workbooks.Open(Filepath)
BKWERK1.RefreshAll
BKWERK2.RefreshAll
BKWERK1.Activate
On Error Resume Next
BKWERK1.Sheets("DATA_FACTUUR-ORDCOLF1").Cells.ClearContents
On Error GoTo 0  ' Reset error handling to default mode

BKWERK2.Sheets("DATA_FACTUUR-ORDCOLF1").UsedRange.Copy


BKWERK1.Activate
BKWERK1.Sheets("DATA_FACTUUR-ORDCOLF1").Cells(1, 1).PasteSpecial Paste:=xlPasteValues

    Cells.Select
    
    Cells.EntireColumn.AutoFit
     
    Dim LastRow As Long
    
    ' Inserting two new columns
    Columns("K:K").Insert Shift:=xlToRight
    Columns("K:K").Insert Shift:=xlToRight
    
    ' Inserting headers
    Range("K1").Value = "TIMESTAMP_DATE"
    Range("L1").Value = "TIMESTAMP_TIME"
    
    ' Finding the last row with data in column AB
    LastRow = Cells(Rows.Count, "J").End(xlUp).Row
    
    ' Setting formulas for columns CU and CV
        Application.Wait eindTijd

    Range("K2").FormulaR1C1 = "=DATE(LEFT(RC[-1],4),MID(RC[-1],5,2),MID(RC[-1],7,2))"
    
        Application.Wait eindTijd

    Range("L2").FormulaR1C1 = "=TIME(MID(RC[-2],9,2),MID(RC[-2],12,2),RIGHT(RC[-2],2))"
        Application.Wait eindTijd

    ' Copying the formulas down to the last row
    Range("K2").AutoFill Destination:=Range("K2:K" & LastRow)
    Range("L2").AutoFill Destination:=Range("L2:L" & LastRow)
    
    ' Formatting columns
    Range("K:K").NumberFormat = "Mm/Dd/yyyy"
    Columns("L:L").NumberFormat = "[$-x-systime]h:mm:ss AM/PM"
    
   Call ABCD_Convert_Numbers_ORDCOLF1_FACT
   'Call ABCD_Convert_Date_ORDERS
   Call ABCD_Convert_Text_ORDCOLF1_FACT
   Call ABCD_Convert_Time_ORDCOLF1_FACT
    
    Cells.Select
    Cells.EntireColumn.AutoFit
    
    
    BKWERK2.Close
    BKWERK1.SaveAs Filename:="\\holwerda-dc01\Data\users\DC Holwerda, Almere\Logistieke accounts\AA. Logistiek Thom\Data analyse 2022\Keukens Analyse\Dura Vermeer\Check Factuur\DATA\SAMPLE\FACT_DATA_DV_ORDCOLF1_" _
    & Format(Now(), "DD-MM-YYYY") & ".xlsm"
    
    'BKWERK1.Close
    
End Sub`

我的问题是关于:

Range("K2").FormulaR1C1 = "=DATE(LEFT(RC[-1],4),MID(RC[-1],5,2),MID(RC[-1],7,2))"
    
        Application.Wait eindTijd

    Range("L2").FormulaR1C1 = "=TIME(MID(RC[-2],9,2),MID(RC[-2],12,2),RIGHT(RC[-2],2))"
        Application.Wait eindTijd`

粘贴时,单元格 L2 具有正确的公式,导致时间,但单元格 K2 返回“=DATE(LEFT(RC[-1],4),MID(RC[-1],5,2),MID(RC[-1],7,2))”而不是必须是日期的公式。

Excel VBA 公式

评论


答:

1赞 rotabor 10/5/2023 #1

在您的方案中,首先应用格式,然后填写单元格:

Range("K:K").NumberFormat = "MM/dd/yyyy"
...
Range("K2").FormulaR1C1 = ...