VBA运行报1004应用程序定义或对象定义错误 求原因解答

SumSheet1.Cells(pasterownum, "E").Value = newvar1行触发1004错误的直接原因：

• 行号变量pasterownum从未赋值，VBA中未显式赋值的数值型变量默认值为0，Excel工作表有效行号从1开始，操作行号为0的单元格必然抛出该应用程序定义错误。

代码中其余会导致异常或逻辑失效的问题：

• 工作表对象SumSheet1仅声明未通过Set绑定实际工作表，调用时会触发"对象变量或With块变量未设置"错误
• For Each c In Range("A:A")遍历整列超100万行单元格，未设置终止边界，会导致代码卡顿甚至无响应
• 字符串拆分、匹配逻辑写在循环内部，但complications_all、newvar1均为循环外固定值，重复执行属于无效冗余逻辑
• 遍历的Range("A:A")未指定所属工作表，默认读取当前活动工作表A列，若活动表不符合预期会直接导致匹配结果错误
• 代码中copystartrow、PDDlastrow、pastestartrow几个行号变量同样未做赋值，运行到对应代码行时也会触发同类错误。

修正后参考代码 #

Dim PDD As Worksheet
Dim SumSheet1 As Worksheet
' 统一声明所有用到的行号变量，提前赋值为有效行号（>=1）
Dim copystartrow As Long, PDDlastrow As Long, pastestartrow As Long, pasterownum As Long
copystartrow = 2
PDDlastrow = 0
pastestartrow = 2
pasterownum = 2 ' 必须根据实际写入位置赋值，不能为0

' 绑定工作表对象
Set PDD = ThisWorkbook.Sheets("Patient Demographics-Diagnosis")
Set SumSheet1 = ThisWorkbook.Sheets("替换为SumSheet1对应的实际工作表名")

' 动态计算BM列最后一行有效行号，避免无效复制
PDDlastrow = PDD.Cells(PDD.Rows.Count, "BM").End(xlUp).Row
PDD.Range("BM" & copystartrow & ":BM" & PDDlastrow).Copy
SumSheet1.Range("C" & pastestartrow).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

Dim complications_all As String
complications_all = SumSheet1.Range("C" & pastestartrow).Value

Dim newvar1 As String
newvar1 = "Urinary calculus, unspecified"
Dim newvarr1

' 字符串匹配无需放在单元格遍历循环中，单次判断即可
newvarr1 = Filter(Split(complications_all, ";"), newvar1, True, vbBinaryCompare)
If Len(Join(newvarr1, ",")) > 0 Then
    SumSheet1.Cells(pasterownum, "E").Value = newvar1
End If

代码中所有行号变量的初始值需根据实际表格业务场景调整，必须保证传入Cells属性的行号参数为大于等于1的正整数。

内容的提问来源于stack exchange，提问作者Shawn Alcantara