VBA 项目（模块 + 表单）在直接保存到工作簿时可以工作，但在保存到个人工作簿时会中断

Question

我的宏查看前一天的报告，如果在其中找到 C 列中的 ID，则给出 true。

当代码和用户表单保存到今天的报告（或我运行的任何一天）时，它就像一个魅力。当我将模块和表单传输到我的个人工作簿时，它崩溃了。

我对公式使用占位符，该占位符将替换为表单中的数据输入。

两列均在 A 列和 B 列中创建，数据验证和格式设置看起来不错。但从 A2 往下看，它是空白的，没有查看上一份报告的公式。

Sub Macro_Test()

Application.ScreenUpdating = False

'Create columns Previous Day and Review Needed
Columns("A:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "Previous Report" 'True or False
Range("B1").Select
ActiveCell.FormulaR1C1 = "Review Needed" 'True or False
Range("A1:B1").Select
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 65535
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
Selection.Font.Bold = True
Columns("A:B").EntireColumn.AutoFit

'Data Validation Review Needed
Range("B2:B5000").Select
With Selection.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:="TRUE,FALSE"
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = True
End With

'Formula for previous day
 UserForm.Show

Range("P1:Q1").Select
Selection.NumberFormat = "@"

Columns("L:L").Select
Selection.Delete Shift:=xlToLeft

    Range("A2").Select
ActiveCell.FormulaR1C1 = _
    "=IF(ISERROR(VLOOKUP(RC[2],'https://website/Reports/[Report - 2024.01.01.xlsx]Sheet1'!C3,1,FALSE))=TRUE,FALSE,TRUE)"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A5000"), Type:=xlFillDefault
Range("A2:A5000").Select

Range("A1:A5000").Replace What:="2024.01.01", Replacement:=Range("Q1") & "." & Range("O1") & "." & Range("P1")

'Returns to A1 and Freeze Row 1
Columns("O:Q").Select
Selection.Delete Shift:=xlToLeft

Range("A1:L1").Select
Selection.AutoFilter

Range("A1").Select
With ActiveWindow
    .SplitColumn = 0
    .SplitRow = 1
End With
ActiveWindow.FreezePanes = True
ActiveWindow.SmallScroll Down:=0

'Delete formula if row is empty
Dim LastRowColC As Long, LastRow As Long
LastRow = ActiveSheet.UsedRange.Rows.Count
LastRowColC = Cells(Rows.Count, "C").End(xlUp).Row
If LastRow > LastRowColC Then
  Rows(LastRowColC + 1 & ":" & LastRow).Clear
End If

Range("A1").Select

Application.ScreenUpdating = True

End Sub


'Submit button from UserForm
Private Sub CommandButton1_Click()

Sheet1.Activate

Range("P1").Value = TextBox1.Value

Range("Q1").Value = TextBox2.Value

Range("R1").Value = TextBox3.Value


Unload Me

End Sub

Answer 1

用户表单用于将数据输入到个人工作簿中。解决方案是参考我的活动表。

私有子CommandButton1_Click()

将此WS调暗为工作表

设置 ThisWS = ActiveWorkbook.Worksheets("Sheet1")

范围（“P1”）.Value = TextBox1.Value

范围（“Q1”）.Value = TextBox2.Value

范围（“R1”）.Value = TextBox3.Value

卸载我

结束子