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

根据ComboBox选择切换Case Size填充区域的VBA AutoFill问题

avatar
AI 小北
2026-6-20
问题描述

我需要根据下拉框（CaseTypeC）的选项（Retail或Vend），将CTextBox4、CTextBox5、CTextBox6的箱规值填充到工作表对应区域。目前文本框的值已经能成功写入单元格，但代码里的AutoFill功能无法正常运行，相关VBA代码如下：

Private Sub CSave_Click()
    On Error GoTo ErrorHandler

    ' Variable Definition
    Dim lr1 As Long, lr2 As Long, lr3 As Long, lr4 As Long, lr5 As Long, lr6 As Long
    
    ' Last Row definitions
    With Sheets("Lays Confirmed")
        lr1 = .Cells(.Rows.Count, "F").End(xlUp).Row + 1
        lr2 = .Cells(.Rows.Count, "G").End(xlUp).Row + 1
        lr3 = .Cells(.Rows.Count, "H").End(xlUp).Row + 1
        lr4 = .Cells(.Rows.Count, "K").End(xlUp).Row + 1
        lr5 = .Cells(.Rows.Count, "O").End(xlUp).Row + 1
        lr6 = .Cells(.Rows.Count, "S").End(xlUp).Row + 1
    End With

    ' Ensure all last rows are the same
    Dim lr As Long
    lr = Application.WorksheetFunction.Max(lr1, lr2, lr3, lr4)

    ' Debug statements
    Debug.Print "Last Row for F: " & lr1
    Debug.Print "Last Row for G: " & lr2
    Debug.Print "Last Row for H: " & lr3
    Debug.Print "Last Row for K: " & lr4
    Debug.Print "Last Row for O: " & lr5
    Debug.Print "Last Row for S: " & lr6
    Debug.Print "Max Last Row: " & lr

    ' UserForm to Cells with validation
    With Sheets("Lays Confirmed")
        If IsNumeric(CTextBox1.Value) Then .Range("F" & lr1).Value = CDbl(CTextBox1.Value)
        If IsNumeric(CTextBox2.Value) Then .Range("G" & lr2).Value = CDbl(CTextBox2.Value)
        If IsNumeric(CTextBox3.Value) Then .Range("H" & lr3).Value = CDbl(CTextBox3.Value)
        .Range("J" & lr4).Value = 7.5
    End With
    
    If CaseTypeC.Value = "Retail" Then
        With Sheets("Lays Confirmed")
            If IsNumeric(CTextBox4.Value) Then .Range("O" & lr5).Value = CDbl(CTextBox4.Value)
            If IsNumeric(CTextBox5.Value) Then .Range("T2").Value = CDbl(CTextBox5.Value)
            If IsNumeric(CTextBox6.Value) Then .Range("T3").Value = CDbl(CTextBox6.Value)
        End With
    ElseIf CaseTypeC.Value = "Vend" Then
        With Sheets("Lays Confirmed")
            If IsNumeric(CTextBox4.Value) Then .Range("S" & lr6).Value = CDbl(CTextBox4.Value)
            If IsNumeric(CTextBox5.Value) Then .Range("W2").Value = CDbl(CTextBox5.Value)
            If IsNumeric(CTextBox6.Value) Then .Range("W3").Value = CDbl(CTextBox6.Value)
        End With
    End If
    
    ' Clear UserForm fields
    With Me
        .CTextBox1.Value = ""
        .CTextBox2.Value = ""
        .CTextBox3.Value = ""
        .CTextBox4.Value = ""
        .CTextBox5.Value = ""
        .CTextBox6.Value = ""
    End With
    Me.CTextBox1.SetFocus

    With Sheets("Lays Confirmed")
        ' AutoFill for Closed Volume(cm^3)
        .Range("B7").Formula = "=ClosedVolumeCm3(C7)"
        If lr > 7 Then
            .Range("B7").AutoFill Destination:=.Range("B7:B" & lr)
        End If

        ' AutoFill for Closed Volume(mm^3)
        .Range("C7").Formula = "=ClosedVolumeMm3(G7,H7,I7,J7)"
        If lr > 7 Then
            .Range("C7").AutoFill Destination:=.Range("C7:C" & lr)
        End If

        ' AutoFill for Current Average Density Product Fill(%)
        .Range("D7").Formula = "=CurrentAverageDensityProductFill(F7, B7, $Q$2)"
        If lr > 7 Then
            .Range("D7").AutoFill Destination:=.Range("D7:D" & lr)
        End If

        ' AutoFill for Current Product Fill at Lowest Density(%)
        .Range("E7").Formula = "=CurrenProductFillAtLowestDensity(F7, B7, $Q$3)"
        If lr > 7 Then
            .Range("E7").AutoFill Destination:=.Range("E7:E" & lr)
        End If

        ' AutoFill for Max PDQ(mm)
        .Range("I7").Formula = "=MaxPDQ(G7,H7,J7,$K$2,$K$3)"
        If lr > 7 Then
            .Range("I7").AutoFill Destination:=.Range("I7:I" & lr)
        End If

        ' AutoFill for Aim PDQ(mm)
        .Range("K7").Formula = "=AimPDQ(G7,I7)"
        If lr > 7 Then
            .Range("K7").AutoFill Destination:=.Range("K7:K" & lr)
        End If

        ' AutoFill for Effect Bag Length(mm)
        .Range("L7").Formula = "=EffectBagLengthMm(H7,I7,J7)"
        If lr > 7 Then
            .Range("L7").AutoFill Destination:=.Range("L7:L" & lr)
        End If

        ' AutoFill for Effect Bag Width(mm)
        .Range("M7").Formula = "=EffectBagWidthMm(I7,G7)"
        If lr > 7 Then
            .Range("M7").AutoFill Destination:=.Range("M7:M" & lr)
        End If

        ' AutoFill for Lw/Ratio
        .Range("N7").Formula = "=LWRatio(H7,G7)"
        If lr > 7 Then
            .Range("N7").AutoFill Destination:=.Range("N7:N" & lr)
        End If
    End With
    
    ' AutoFill for CaseTypeC "Retail"
    If CaseTypeC.Value = "Retail" Then
        With Sheets("Lays Confirmed")
            ' AutoFill for Standup # Bags/CS
            .Range("P7").Formula = "=StandUpBagsCs(G7, I7, L7, O7, T$2$, T$3$)"
            If lr > 7 Then
                .Range("P7").AutoFill Destination:=.Range("P7:P" & lr)
            End If
            
            ' AutoFill for Side Pack # Bags/CS
            .Range("Q7").Formula = "=SidePacksBagsCs(H7, I7, J7, M7, O7, T$2$, T$3$)"
            If lr > 7 Then
                .Range("Q7").AutoFill Destination:=.Range("Q7:Q" & lr)
            End If
            
            ' AutoFill for Multi-Laye # Bags/CS
            .Range("R7").Formula = "=MultiLayerBagsCs(C7, G7, O7, T$2$, T$3$)"
            If lr > 7 Then
                .Range("R7").AutoFill Destination:=.Range("R7:R" & lr)
            End If
        
        End With
    ElseIf CaseTypeC.Value = "Vend" Then
        
        With Sheets("Lays Confirmed")
            
            ' AutoFill for Standup # Bags/CS
            .Range("T7").Formula = "=StandUpBagsCs(G7, I7, L7, S7, W$2$, W$3$)"
            If lr > 7 Then
                .Range("T7").AutoFill Destination:=.Range("T7:T" & lr)
            End If
            
            ' AutoFill for Side Pack # Bags/CS
            .Range("U7").Formula = "=SidePacksBagsCs(H7, I7, J7, M7, S7, W$2$, W$3$)"
            If lr > 7 Then
                .Range("U7").AutoFill Destination:=.Range("U7:U" & lr)
            End If
            
            ' AutoFill for Multi-Laye # Bags/CS
            .Range("V7").Formula = "=MultiLayerBagsCs(C7, G7, S7, W$2$, W$3$)"
            If lr > 7 Then
                .Range("V7").AutoFill Destination:=.Range("V7:V" & lr)
            End If
        
        End With
    End If
    
    Exit Sub

ErrorHandler:
    MsgBox "Error: " & Err.Description, vbExclamation, "Error"
End Sub
问题排查与修复方案

1. 最后一行（lr）计算逻辑错误

当前代码在写入数据前计算lr，但写入后各列的最后一行已经更新，导致lr值不准确；同时O、S列的最后一行未纳入lr计算，AutoFill范围可能覆盖不全。

修复：将lr计算移到数据写入之后，且包含所有需要AutoFill的列：

' 写入数据后执行
With Sheets("Lays Confirmed")
    lr1 = .Cells(.Rows.Count, "F").End(xlUp).Row
    lr2 = .Cells(.Rows.Count, "G").End(xlUp).Row
    lr3 = .Cells(.Rows.Count, "H").End(xlUp).Row
    lr4 = .Cells(.Rows.Count, "K").End(xlUp).Row
    lr5 = .Cells(.Rows.Count, "O").End(xlUp).Row
    lr6 = .Cells(.Rows.Count, "S").End(xlUp).Row
    lr = Application.WorksheetFunction.Max(lr1, lr2, lr3, lr4, lr5, lr6)
End With

2. AutoFill触发条件与方式问题

原代码用If lr >7 Then判断，首次写入数据时lr=7，公式不会被填充；且AutoFill本身易受单元格格式、数据连续性影响。

优化：直接给整个目标区域赋值公式，替代AutoFill，更稳定高效：

' 替代原AutoFill代码
.Range("B7:B" & lr).Formula = "=ClosedVolumeCm3(C7)"
.Range("C7:C" & lr).Formula = "=ClosedVolumeMm3(G7,H7,I7,J7)"

3. 公式拼写错误

原代码中CurrenProductFillAtLowestDensity少了一个字母t，应为CurrentProductFillAtLowestDensity，会导致公式无法计算。

完整修复后的代码 
Private Sub CSave_Click()
    On Error GoTo ErrorHandler

    ' Variable Definition
    Dim lr1 As Long, lr2 As Long, lr3 As Long, lr4 As Long, lr5 As Long, lr6 As Long
    Dim lr As Long
    
    ' 获取未写入数据前的各列最后一行
    With Sheets("Lays Confirmed")
        lr1 = .Cells(.Rows.Count, "F").End(xlUp).Row + 1
        lr2 = .Cells(.Rows.Count, "G").End(xlUp).Row + 1
        lr3 = .Cells(.Rows.Count, "H").End(xlUp).Row + 1
        lr4 = .Cells(.Rows.Count, "K").End(xlUp).Row + 1
        lr5 = .Cells(.Rows.Count, "O").End(xlUp).Row + 1
        lr6 = .Cells(.Rows.Count, "S").End(xlUp).Row + 1
        
        ' 写入表单数据
        If IsNumeric(CTextBox1.Value) Then .Range("F" & lr1).Value = CDbl(CTextBox1.Value)
        If IsNumeric(CTextBox2.Value) Then .Range("G" & lr2).Value = CDbl(CTextBox2.Value)
        If IsNumeric(CTextBox3.Value) Then .Range("H" & lr3).Value = CDbl(CTextBox3.Value)
        .Range("J" & lr4).Value = 7.5
    End With
    
    ' 根据下拉框写入箱规数据
    If CaseTypeC.Value = "Retail" Then
        With Sheets("Lays Confirmed")
            If IsNumeric(CTextBox4.Value) Then .Range("O" & lr5).Value = CDbl(CTextBox4.Value)
            If IsNumeric(CTextBox5.Value) Then .Range("T2").Value = CDbl(CTextBox5.Value)
            If IsNumeric(CTextBox6.Value) Then .Range("T3").Value = CDbl(CTextBox6.Value)
        End With
    ElseIf CaseTypeC.Value = "Vend" Then
        With Sheets("Lays Confirmed")
            If IsNumeric(CTextBox4.Value) Then .Range("S" & lr6).Value = CDbl(CTextBox4.Value)
            If IsNumeric(CTextBox5.Value) Then .Range("W2").Value = CDbl(CTextBox5.Value)
            If IsNumeric(CTextBox6.Value) Then .Range("W3").Value = CDbl(CTextBox6.Value)
        End With
    End If
    
    ' 清空表单
    With Me
        .CTextBox1.Value = ""
        .CTextBox2.Value = ""
        .CTextBox3.Value = ""
        .CTextBox4.Value = ""
        .CTextBox5.Value = ""
        .CTextBox6.Value = ""
    End With
    Me.CTextBox1.SetFocus

    ' 写入数据后重新计算最后一行
    With Sheets("Lays Confirmed")
        lr1 = .Cells(.Rows.Count, "F").End(xlUp).Row
        lr2 = .Cells(.Rows.Count, "G").End(xlUp).Row
        lr3 = .Cells(.Rows.Count, "H").End(xlUp).Row
        lr4 = .Cells(.Rows.Count, "K").End(xlUp).Row
        lr5 = .Cells(.Rows.Count, "O").End(xlUp).Row
        lr6 = .Cells(.Rows.Count, "S").End(xlUp).Row
        lr = Application.WorksheetFunction.Max(lr1, lr2, lr3, lr4, lr5, lr6)
        
        ' 批量设置公式
        .Range("B7:B" & lr).Formula = "=ClosedVolumeCm3(C7)"
        .Range("C7:C" & lr).Formula = "=ClosedVolumeMm3(G7,H7,I7,J7)"
        .Range("D7:D" & lr).Formula = "=CurrentAverageDensityProductFill(F7, B7, $Q$2)"
        .Range("E7:E" & lr).Formula = "=CurrentProductFillAtLowestDensity(F7, B7, $Q$3)"
        .Range("I7:I" & lr).Formula = "=MaxPDQ(G7,H7,J7,$K$2,$K$3)"
        .Range("K7:K" & lr).Formula = "=AimPDQ(G7,I7)"
        .Range("L7:L" & lr).Formula = "=EffectBagLengthMm(H7,I7,J7)"
        .Range("M7:M" & lr).Formula = "=EffectBagWidthMm(I7,G7)"
        .Range("N7:N" & lr).Formula = "=LWRatio(H7,G7)"
    End With
    
    ' 根据下拉框设置对应列公式
    If CaseTypeC.Value = "Retail" Then
        With Sheets("Lays Confirmed")
            .Range("P7:P" & lr).Formula = "=StandUpBagsCs(G7, I7, L7, O7, T$2$, T$3$)"
            .Range("Q7:Q" & lr).Formula = "=SidePacksBagsCs(H7, I7, J7, M7, O7, T$2$, T$3$)"
            .Range("R7:R" & lr).Formula = "=MultiLayerBagsCs(C7, G7, O7, T$2$, T$3$)"
        End With
    ElseIf CaseTypeC.Value = "Vend" Then
        With Sheets("Lays Confirmed")
            .Range("T7:T" & lr).Formula = "=StandUpBagsCs(G7, I7, L7, S7, W$2$, W$3$)"
            .Range("U7:U" & lr).Formula = "=SidePacksBagsCs(H7, I7, J7, M7, S7, W$2$, W$3$)"
            .Range("V7:V" & lr).Formula = "=MultiLayerBagsCs(C7, G7, S7, W$2$, W$3$)"
        End With
    End If
    
    Exit Sub

ErrorHandler:
    MsgBox "错误: " & Err.Description,
相关产品推荐
方舟 Agent Plan

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

产品介绍相关文档
相关产品推荐
方舟 Agent Plan

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

产品介绍相关文档
火山引擎 最新活动
全面开放
Doubao-Seedance-2.5全新模型升级

模型再升级,30秒超长叙事, 模态参考扩容

HOT
方舟Codingplan

模型自由，工具不限，最新支持 Deepseek-V4 系列、GLM-5.3 系列

HOT
方舟Agent plan

超全模态模型 × Harness 升级，最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列

HOT
新用户特惠专场

大模型19元起，Al应用9.9元畅享，新人首购爆款尽享优惠

最近更新时间：2026.06.20 12:30:13