You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

VBA代码逻辑相近却表现不同:自动填充列功能失效排查求助

CSV导入后自动填充功能失效排查

我有两个Excel文件,均导入包含14列的CSV文件。其中一个文件会自动填充其他列数据,另一个却无法实现该功能。我不清楚自动填充指令的来源,也无法定位功能失效的具体原因。

近期导入的CSV文件新增了14列,我在导入逻辑中添加偏移量后,其中一份文件运行恢复正常,但另一份的自动填充功能仍未生效。

失效的VBA代码

Sub RunReport()

    'Copy and Paste New Data from cvdata
    Dim PDate As Date, DMonth As String, DYear As Long, FilePath As String, Usage As String, nextrow As Long, tablecount As Long, pivotcount As Long, newrows As Long
    Dim lastrow As Long, newnewrows As Long, foundRng As Range, CurrentDay As String, FDate As Date, FMonth As String, FDay As String
        
        
    PDate = DateAdd("m", -1, Date)
    DMonth = Format(PDate, "mm")
    DYear = Year(PDate)
    
    'CLEAR OLD DATA
    Usage = "CVK Usage_" & DYear & DMonth
    ThisWorkbook.Activate
    Worksheets("CVDataK").Select
    Range("Table2").Select
    Application.DisplayAlerts = False
    Selection.Delete
    
    FilePath = "N:\Reports\batecuanhuehue\cvdata.csv"

    Workbooks.Open (FilePath)

        'COPY NEW DATA
        Set tbl = ActiveCell.CurrentRegion
        tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, _
        tbl.Columns.Count - 14).Select
        Selection.Copy

        'PASTE NEW DATA
        Usage = "CVK Usage_" & DYear & DMonth
        ThisWorkbook.Activate
        Worksheets("CVDataK").Select
        Range("A2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        
    'Clear Clipboard and close File
    Workbooks("cvdata.csv").Activate
    Application.CutCopyMode = False
    ActiveWindow.Close
    
    'Refresh All Pivots
    ActiveWorkbook.RefreshAll


    'Update Table Copy and Paste First Column
    
    'Count the number of rows in the selection
    Worksheets("CVUsage1").Activate
    
    Range("A12").End(xlToRight).Select
    Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(3, 0)).Select
    Selection.Copy
    
   'First empty row of table
    lastrow = Cells(Rows.Count, 1).End(xlUp).Row
    
    Range("T5:AB5").Select
    Selection.Copy
    Range("T5:AB" & lastrow).Select
    ActiveSheet.Paste

    ActiveSheet.ListObjects("Table3").Resize Range("$AD$4:$Bu$" & lastrow)

    'Clear Clipboard
    Application.CutCopyMode = False
    
    'Refresh All Pivots
    ActiveWorkbook.RefreshAll

    
    FDate = Date - 1
    'FDay = Format(FDate, "d")
    'FMonth = Format(FDate, "m")
    CurrentDay = FDate


Sheets("CVUsage1").Select
Set foundRng = Range("AJ:AJ").Find(CStr(CurrentDay), lookat:=xlWhole, LookIn:=xlValues)
 
If foundRng Is Nothing Then
    MsgBox "Sample Date not found"
Else
    Sheets("Report").Select

    ActiveSheet.PivotTables("PivotTable4").PivotFields("Sample Date").ClearAllFilters
    ActiveSheet.PivotTables("PivotTable4").PivotFields("Sample Date").EnableMultiplePageItems = False
    ActiveSheet.PivotTables("PivotTable4").PivotFields("Sample Date").CurrentPage = FDate
  
End If

    Sheets("Calculations").Select



End Sub

可正常运行的VBA代码

Sub RunReport()

    'On Error GoTo ErrHandler
    Application.ScreenUpdating = False


    'Copy and Paste New Data
    Dim PDate As Date, DMonth As String, DYear As Long, FilePath As String, JktntUsage As String, tablecount As Long, pivotcount As Long, newrows As Long
    Dim lastrow As Long, newnewrows As Long, foundRng As Range, CurrentDay As String, FDate As Date, FMonth As String, FDay As String
 
    PDate = DateAdd("m", -1, Date)
    DMonth = Format(PDate, "mm")
    DYear = Year(PDate)
    
    'CLEAR OLD DATA
    Usage = "PlasticK Usage" & DYear & DMonth
    ThisWorkbook.Activate
    Worksheets("plastick").Select
    Range("Table1").Select
    Application.DisplayAlerts = False
    'Selection.Delete
    
    FilePath = "N:\Reports\batecuanhuehue\plasticdata.csv"

    Workbooks.Open (FilePath)

        'COPY NEW DATA
        Set tbl = ActiveCell.CurrentRegion
        tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, _
        tbl.Columns.Count - 14).Select
        Selection.Copy

        'PASTE NEW DATA
        JktntUsage = "PlasticK Usage" & DYear & DMonth
        ThisWorkbook.Activate
        Worksheets("plastick").Select
        Range("A2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
    'Clear Clipboard and close File
    Workbooks("plasticdata.csv").Activate
    Application.CutCopyMode = False
    ActiveWindow.Close
    
    'Refresh All Pivots
    ActiveWorkbook.RefreshAll
  
    'Count the number of rows in the selection
    Worksheets("Plastic Usage1").Activate
    
    
   'First empty row of table
    lastrow = Cells(Rows.Count, 1).End(xlUp).Row
    ActiveSheet.ListObjects("Table3").Resize Range("$AA$4:$BK$" & lastrow)

    'Refresh All Pivots
    ActiveWorkbook.RefreshAll

    Range("A12").End(xlToRight).Select
    Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(3, 0)).Select
    Selection.Copy

    Worksheets("Plastic Summary").Activate
    
'ErrHandler:
    'Application.EnableEvents = True
    'Application.ScreenUpdating = True
    
    
    FDate = Date - 1
    'FDay = Format(FDate, "d")
    'FMonth = Format(FDate, "m")
    CurrentDay = FDate


    Sheets("Plastic Usage1").Select
    Set foundRng = Range("AE:AE").Find(CStr(CurrentDay), lookat:=xlWhole, LookIn:=xlValues)
 
    If foundRng Is Nothing Then
    MsgBox "Sample Date not found"
    Else
    Sheets("Report").Select

    ActiveSheet.PivotTables("PivotTable3").PivotFields("Sample Date").ClearAllFilters
    ActiveSheet.PivotTables("PivotTable3").PivotFields("Sample Date").EnableMultiplePageItems = False
    ActiveSheet.PivotTables("PivotTable3").PivotFields("Sample Date").CurrentPage = FDate
  
    End If

    Sheets("Calculations").Select


End Sub

内容的提问来源于stack exchange,提问作者User

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.07.04 09:20:02