繁体   English   中英

Excel:在VBA中插入包含excel公式的新行[更新]

[英]Excel: Insert new row that contains excel formula in VBA[Updated]

我有项目的样本数据。 如您所见,共有4个栏位:截止日期,提交,说明和days_delayed。 另外,在同一张纸上,我有数据的插入形式。 其中,范围G1是截止日期,而范围G3是用户提交其文档的实际日期。

在此处输入图片说明

在此代码中,您将在vba内以公式方式编写条件语句。 这样,每次添加新行时,公式都会遵循并复制到其相应的单元格范围。

    Private Sub CommandButton1_Click()

    Dim Deadline, Submitted, Description, Days_Delayed As String
    Worksheets("Sheet3").Select
    Deadline = Range("G1")
    Submitted = Range("G3")
    Description = "=IF(AND(D2>0,ISBLANK(B2)),"NO- 
    DOCUMENT",IF(AND(D2<=0,NOT(ISBLANK(B2))),"ON-TIME", IF(AND(D2 > 0,NOT(ISBLANK(B2))),"DELAYED")))"
    Days_Delayed = "=IF(COUNT(A2:B2)=2,B2-A2,IF(B2="","0"))"


    Worksheets("Sheet3").Select
    Worksheets("Sheet3").Range("A2").Select
    If Worksheets("Sheet3").Range("A2").Offset(1, 0) <> "" Then
    Worksheets("Sheet3").Range("A2").End(xlDown).Select
    End If



    ActiveCell.Offset(1, 0).Select
    ActiveCell.Value = Deadline
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Value = Submitted
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Formula = Description
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Formula = Days_Delayed

    End Sub

这段代码工作正常,但是当我尝试在vba代码内部实现公式时。 错误说“声明结束”


由Peh修复将公式插入VBA应该像这样

Days_Delayed = "=IF(COUNT(N36:O36)=2,O36-N36,IF(O36="""",TODAY()-N36))"

另一个问题是:

由于添加新行是新数据,因此公式不应在其中放置定义的范围。

Days_Delayed = "=IF(COUNT(N36:O36)=2,O36-N36,IF(O36="""",TODAY()-N36))"

在此公式中,您可以看到已定义公式范围。 我要解决的是做这样的事情:

Days_Delayed = "=IF(COUNT(N(i):O(i))=2,O(i)-N(i),IF(O(i)="""",TODAY()-(i)))"

您会看到有变量i,所以当有新行进入时。该公式将自动知道需要计算哪些单元格。 我猜想,循环是实现此目的的合适方法。 因为如果我保持定义范围内的相同公式。 输出将是相同的。 那可能吗?

主要问题是您使用.Select 而是使用以下命令确定下一个空闲行号

nRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1 

并使用它直接访问ws.Cells(nRow, "A").Value

另外,请勿将变量声明为String而应使用Dim Deadline As Range否则您的日期将被转换为字符串,并且您将无法再使用该日期进行计算。

在公式中,行号需要用" & nRow & "代替,以插入下一个空闲行的行号,而不是固定的行号。

Option Explicit

Public Sub AddData()
    Dim ws As Worksheet 'define worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet3")

    Dim Deadline As Range 'define deadline range
    Set Deadline = ws.Range("G1")

    Dim Submitted As Range 'define submitted range
    Set Submitted = ws.Range("G3")

    Dim nRow As Long 'find next free row = last used used row +1
    nRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1


    ws.Cells(nRow, "A").Value = Deadline.Value
    ws.Cells(nRow, "B").Value = Submitted.Value

    ws.Cells(nRow, "C").Formula = "=IF(AND(D" & nRow & ">0,ISBLANK(B" & nRow & ")),""NO-DOCUMENT"",IF(AND(D" & nRow & "<=0,NOT(ISBLANK(B" & nRow & "))),""ON-TIME"", IF(AND(D" & nRow & " > 0,NOT(ISBLANK(B" & nRow & "))),""DELAYED"")))"
    ws.Cells(nRow, "D").Formula = "=IF(COUNT(A" & nRow & ":B" & nRow & ")=2,B" & nRow & "-A" & nRow & ",IF(B" & nRow & "="""",""0""))"
End Sub

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM