VBA SUMIF 公式未正确计算结果

Question

我有一些 VBA 代码经过几千行数据，执行 SUMIF，然后据说执行“立即计算”。它在 VBA 中运行良好，我的问题是，在输出中，格式显示为“常规”，无论我手动单击“立即计算”多少次，它仍然显示 0。我必须进入单元格并然后单击它以使其意识到它是一个数字/公式并以这种方式运行。然后当我 F9 工作表时，它重新计算就好了。

你知道为什么会这样吗？

我使用的 VBA 代码如下：

Sub MySub()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim WorkbookPathName As String
Dim wb As Workbook
Dim StrDate As String

StrDate = Format(Range("G6"), "dd-mm-yyyy")

Set wb = Workbooks.Add

WorkbookPathName = "MyPath" & StrDate

wb.SaveAs Filename:=WorkbookPathName, _
FileFormat:=51

wb.Activate

Dim FileSys As FileSystemObject
Dim objFile As File
Dim myFolder
Dim strFilename As String
Dim dteFile As Date

Const myDir As String = "MyDir"
    
    'set up filesys objects
    Set FileSys = New FileSystemObject
    Set myFolder = FileSys.GetFolder(myDir)
    
    Set FileSysL = New FileSystemObject
    Set myFolderL = FileSys.GetFolder(myDir)
    
    'loop through each file and get date last modified. If largest date then store Filename
    dteFile = Workbooks("Myworkbook.xlsm").Sheets("Start").Range("G6").Value
    For Each objFile In myFolder.Files
        If objFile.DateLastModified > dteFile Then
            dteFile = objFile.DateLastModified
            strFilename = objFile.Name
        End If
    Next objFile

    Workbooks.Open myDir & "\" & strFilename, ReadOnly:=True
    Workbooks(strFilename).Activate
 
 Range("A1:CA1").AutoFilter Field:=32, Criteria1:=Array( _
        "filter for some text which is irrelevant to the point here"), Operator:=xlFilterValues

Range("A1:CA1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

wb.Activate
Range("A1").Select
ActiveSheet.Paste

Workbooks(strFilename).Activate
ThisWorkbook.Saved = True
ActiveWorkbook.Close

wb.Activate
Sheets("Sheet1").Name = "Data"

Application.Calculation = xlCalculationAutomatic

Dim LastRow As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row

Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "Country"
Range("A2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[2]="""","""",LEFT(RC[28],2))"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A" & LastRow)
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.FormulaR1C1 = "lvl"
Range("A2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[3]="""","""", CONCATENATE(RC[29]&RC[41]))"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A" & LastRow)
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "Lvl Net"
Range("A2").Select
ActiveCell.FormulaR1C1 = "=SUMIF(C[1],RC[1],C[13])/COUNTIF(C[1],RC[1])"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A" & LastRow)
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "Final"
Range("A2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[2]>0,""Buy"",""Sell"")"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A" & LastRow)

Const sName As String = "Summary" ' Source Worksheet Name
Const cName As String = "Data" ' Criteria Worksheet Name
Const dColTitle As String = "My Column"
Const dCol As String = "A"

Dim dws As Worksheet: Set dws = ActiveSheet

dws.Columns(dCol).Insert xlToRight, xlFormatFromLeftOrAbove
    
With dws.Columns(dCol)
        .Cells(1).Value = dColTitle
        .Cells(2).Resize(LastRow - 1).FormulaR1C1 = _
            "=SUMIF('" & sName & "'!C[19],'" & cName & "'!RC[32],'" _
            & sName & "'!C)"
    End With

Answer 1

插入列并编写公式

• 两种解决方案的作用相同。
• 如果您要写信给Data，请使用??? 和? 行。

Option Explicit

Sub InsertAndWrite()
    
    Dim LastRow As Long: LastRow = 10 ' e.g.
    
    Dim dws As Worksheet: Set dws = ActiveSheet
    'Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code ?
    'Dim dws As Worksheet: Set dws = wb.Worksheets("Data") '???
    
    With dws.Columns("A")
        If .Cells(1).Value = "My Column" Then
            .Delete
        End If
    End With
    
    dws.Columns("A").Insert xlToRight, xlFormatFromLeftOrAbove
    
    With dws.Columns("A")
        .Cells(1).Value = "My Column"
        .Cells(2).Resize(LastRow - 1).FormulaR1C1 = _
            "=SUMIF('Summary'!C[19],'Data'!RC[32],'Summary'!C)"
    End With

End Sub


Sub InsertAndWriteUsingConstants()
    
    Const sName As String = "Summary" ' Source Worksheet Name
    Const cName As String = "Data" ' Criteria Worksheet Name
    'Const dName As String = "Data" ' Destination Worksheet Name '???
    
    Const dColTitle As String = "My Column"
    Const dCol As String = "A"
    
    Dim LastRow As Long: LastRow = 10 ' e.g.
    
    Dim dws As Worksheet: Set dws = ActiveSheet
    'Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code ?
    'Dim dws As Worksheet: Set dws = wb.Worksheets(dName) '???
    
    With dws.Columns(dCol)
        If .Cells(1).Value = dColTitle Then
            .Delete
        End If
    End With
    
    dws.Columns(dCol).Insert xlToRight, xlFormatFromLeftOrAbove
    
    With dws.Columns(dCol)
        .Cells(1).Value = dColTitle
        .Cells(2).Resize(LastRow - 1).FormulaR1C1 = _
            "=SUMIF('" & sName & "'!C[19],'" & cName & "'!RC[32],'" _
            & sName & "'!C)"
    End With

End Sub