ListRows.Add 似乎不起作用
ListRows.Add doesn't appear to work
我有一个非常奇怪的案例......希望有人能够帮助我，我搜索了很多论坛寻找解决方案，我能找到的最接近的（有点）是 here, 虽然我已经尝试了所有的建议都无济于事…
我正在尝试 运行 一个函数到 return 一个字符串中的数据列表，该字符串由来自 oracle 存储函数的分号分隔。 （这个值函数调用似乎工作正常）。
然后我遍历每个数据值的字符串并将其打印到我的子例程中声明的空白 table （0 行）。我用它来加载到访问数据库中。 （只要相信它在大局中是有意义的……）。
问题，根本上是没有信息打印到table。但是，当我单步执行代码时，它工作正常。
故障排除后，我认为（请参阅代码下方的测试场景）问题出现在 listrows.add 行之后...虽然不是很明显。
我不认为在第一个值试图打印到 table 时执行此行。
最令人困惑的部分是我运行在这部分之前完成了 2 个几乎相同的过程（调用函数 -> Return 值 -> 将值打印到 table）的代码，他们工作没有失败。
代码摘录：
'run function to get string ... this works
DoEvents ' not in original design
RelRtnStr = Prnt(Cat, "A Third Oracle Function Name")
DoEvents ' not in original design
RelChopVar = RelRtnStr
StrFldCnt = 0
Checking = True ''' CodeBreak Test 1
DoEvents ' not in original design
AppendRlLmTbl.ListRows.Add ''''''''This isn't appearing to work...
DoEvents ' not in original design
Debug.Print Now ' not in original design
Application.Wait (Now + TimeValue("0:00:3")) ' not in original design
Debug.Print Now ' not in original design
While StrFldCnt < 80 And (Len(RelChopVar) - Len(Replace(RelChopVar, ";", ""))) > 0 And Checking
'## Count String Position
StrFldCnt = StrFldCnt + 1
'## Find Current String Value & Remainder String
If InStr(RelChopVar, ";") <> 0 Then
'Multiple Values Left
FldVal = Replace(Left(RelChopVar, InStr(RelChopVar, ";")), ";", "")
RelChopVar = Right(RelChopVar, Len(RelChopVar) - InStr(RelChopVar, ";"))
Else
'Last Value
FldVal = RelChopVar
Checking = False
End If
'## Get Field Name For Current Value & Print to Table
FldNm = CStr(RefRtrn(2, CStr(StrFldCnt))) ''' CodeBreak Test 2
AppendRlLmTbl.ListColumns(FldNm).DataBodyRange.Value = FldVal '''CodeBreak 2 error thrown
Debug.Print StrFldCnt & FldNm & FldVal
Wend
AppendRlLmTbl.ListColumns("Catalogue").DataBodyRange.Value = Cat
到目前为止，我已经测试了网上建议的大量选项，不一定理解每个测试...这就是我收集到的内容。
如果我单步执行代码，它会起作用
如果我在 "CodeBreak Test 1" 和 "F5" 其余位置设置断点，它会工作......
如果我在 "CodeBreak Test 2" 处设置断点，我会抛出“未设置变量的对象”错误...
我尝试过的事情……
用DoEvents
在 listObjects.add 行后设置等待时间
验证代码在 运行 宁 "full procured" 时执行 While 循环（而不是单步执行）
最糟糕的是，我不知道为什么在添加行行之后设置断点时对象无法正确声明，但在之前设置断点时正确设置并且在 [=85= 时没有抛出错误] 完整的程序（我没有错误声明。）...
它当然在我看来一定是相关的，但我在网上找不到任何信息，不幸的是，我没有正式的 VBA 背景和 1 个本科课程作为一般的编程背景。也就是我超出了我的深度并且非常沮丧。
PS。首先 post，所以请保持友好 :p
完整代码如下：
Option Explicit
'## Here's my attempt to clean up and standardize the flow
'## Declare my public variables
' WorkBook
Public WB As Workbook
' Sheets
Public Req2ByWS As Worksheet
Public ReqSpecsWS As Worksheet
Public ReqInstrcWS As Worksheet
Public ConfigReqWS As Worksheet
Public AppendReqWS As Worksheet
Public AppendRlLmWS As Worksheet
' Objects (tables)
Public ReqConfigTbl As ListObject
Public SpecConfigTbl As ListObject
Public CurrRegIDTbl As ListObject
Public AppendReqTbl As ListObject
Public AppendRlLmTbl As ListObject
'## ##
'## Get Data from Tom's Functions ##
Sub GetSpotBuyData()
'## Preliminary Config ##
'## Turn OFF Warnings & Screen Updates
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'## Set global Referances to be used in routine
' WorkBooks
Set WB = Workbooks("MyWb.xlsm")
' WorkSheets
Set Req2ByWS = WB.Sheets("MyWb Pg1")
Set ReqSpecsWS = WB.Sheets("MyWb Pg2")
Set ConfigReqWS = WB.Sheets("MyWb Pg3")
Set AppendReqWS = WB.Sheets("MyWb Pg4")
Set AppendRlLmWS = WB.Sheets("MyWb Pg5")
' Tables
Set ReqConfigTbl = ConfigReqWS.ListObjects("MyWS Tbl1")
Set SpecConfigTbl = ConfigReqWS.ListObjects("MyWS Tbl2")
Set CurrRegIDTbl = ConfigReqWS.ListObjects("MyWS Tbl3")
Set AppendReqTbl = AppendReqWS.ListObjects("MyWS Tbl4")
Set AppendRlLmTbl = AppendRlLmWS.ListObjects("MyWS Tbl5")
'## Declare Routine Specefic Variables
Dim Doit As Variant
Dim Checking As Boolean
Dim Cat As String
Dim CatRtnStr As String
Dim CatChopVar As String
Dim SpecRtnStr As String
Dim SpecChopVar As String
Dim RelRtnStr As String
Dim RelChopVar As String
Dim FldVal As String
Dim FldNm As String
Dim StrFldCnt As Integer
'## 1) General Set-Up ##
'## Unprotect tabs (loop through All Tabs Unprotect)
Doit = Protct(False, WB, "Mypassword")
'## Refresh Data
Doit = RunUpdateAl(WB)
'## 2) Find the Catalgue we are playing with ##
'## Grab Catalogue input from ISR
If [Catalogue].Value = "" Then
MsgBox ("Please Enter a Catalogue")
GoTo ExitSub
Else
Cat = [Catalogue].Value
End If
'## 3) Run Toms Function and print the results to the form & Append Table ##
'## 3a) Do it for Cat Info Function
'## Get Cat Info String From Function
CatRtnStr = Prnt(Cat, "An Oracle Functions Name")
CatChopVar = CatRtnStr
If CatChopVar = "No Info" Then
MsgBox ("No Info Found in Catalogue Data Search.")
GoTo SkipCatInfoPrint
End If
'## Loop Through Data String & Write to Form
StrFldCnt = 0
Checking = True
AppendReqTbl.ListRows.Add
While Checking
'## Count String Position
StrFldCnt = StrFldCnt + 1
'## Find Current String Value & Remainder String
If InStr(CatChopVar, ";") <> 0 Then
'Multiple Values Left
FldVal = Replace(Left(CatChopVar, InStr(CatChopVar, ";")), ";", "")
CatChopVar = Right(CatChopVar, Len(CatChopVar) - InStr(CatChopVar, ";"))
Else
'Last Value
FldVal = CatChopVar
Checking = False
End If
'## Get Field Name For Current Value & Print to Form
FldNm = CStr(RefRtrn(1, CStr(StrFldCnt)))
If FldNm <> "CustomerSpecification" And FldNm <> "ShiptoAddress" Then
'Take Value as is
Req2ByWS.Range(FldNm).Value = FldVal
AppendReqTbl.ListColumns(FldNm).DataBodyRange.Value = FldVal
ElseIf FldNm = "CustomerSpecification" Then
'Replace : with New Line
FldVal = Replace(FldVal, " : ", vbLf)
Req2ByWS.Range(FldNm).Value = FldVal
AppendReqTbl.ListColumns(FldNm).DataBodyRange.Value = FldVal
ElseIf FldNm = "ShiptoAddress" Then
'Replace - with New Line
FldVal = Replace(FldVal, " - ", vbLf)
Req2ByWS.Range(FldNm).Value = FldVal
AppendReqTbl.ListColumns(FldNm).DataBodyRange.Value = FldVal
End If
Wend
'## 3b) Do it for Spec Function
SkipCatInfoPrint:
'## Get Spec Info String From Function
SpecRtnStr = Prnt(Cat, "Another Oracle Functions Name")
SpecChopVar = SpecRtnStr
If SpecChopVar = "No Info" Then
MsgBox ("No Info Found in Data Search.")
GoTo SkipSpecInfoPrint
End If
'## Loop Through Data String & Write to Form
StrFldCnt = 0
Checking = True
While StrFldCnt < 80 And (Len(SpecChopVar) - Len(Replace(SpecChopVar, ";", ""))) > 0 And Checking
'## Count String Position
StrFldCnt = StrFldCnt + 1
'## Find Current String Value & Remainder String
If InStr(SpecChopVar, ";") <> 0 Then
'Multiple Values Left
FldVal = Replace(Left(SpecChopVar, InStr(SpecChopVar, ";")), ";", "")
SpecChopVar = Right(SpecChopVar, Len(SpecChopVar) - InStr(SpecChopVar, ";"))
Else
'Last Value
FldVal = SpecChopVar
Checking = False
End If
'## Get Field Name For Current Value & Print to Form
FldNm = CStr(RefRtrn(2, CStr(StrFldCnt)))
ReqSpecsWS.Range(FldNm).Value = FldVal
AppendReqTbl.ListColumns(FldNm).DataBodyRange.Value = FldVal
Wend
'## 3c) Do it for Rel Limits Function
SkipSpecInfoPrint:
'## Get Rel Limits String From Function
RelRtnStr = Prnt(Cat, "A Third Functions Name")
RelChopVar = RelRtnStr
If RelChopVar = "No Info" Then
MsgBox ("No Info Found in Data Search.")
GoTo ExitSub
End If
'## Loop Through Data String & Write to Form
StrFldCnt = 0
Checking = True
AppendRlLmTbl.ListRows.Add
While StrFldCnt < 80 And (Len(RelChopVar) - Len(Replace(RelChopVar, ";", ""))) > 0 And Checking
'## Count String Position
StrFldCnt = StrFldCnt + 1
'## Find Current String Value & Remainder String
If InStr(RelChopVar, ";") <> 0 Then
'Multiple Values Left
FldVal = Replace(Left(RelChopVar, InStr(RelChopVar, ";")), ";", "")
RelChopVar = Right(RelChopVar, Len(RelChopVar) - InStr(RelChopVar, ";"))
Else
'Last Value
FldVal = RelChopVar
Checking = False
End If
'## Get Field Name For Current Value & Print to Form
FldNm = CStr(RefRtrn(2, CStr(StrFldCnt)))
AppendRlLmTbl.ListColumns(FldNm).DataBodyRange.Value = FldVal
Wend
AppendRlLmTbl.ListColumns("SpecificFieldName").DataBodyRange.Value = Cat
'## 4) Re-Format and Clean Up Program ##
ExitSub:
'## Clean-Up Formatting
Req2ByWS.Range("F:F", "C:C").ColumnWidth = 30
Req2ByWS.UsedRange.Rows.AutoFit
Req2ByWS.UsedRange.Columns.AutoFit
Req2ByWS.Range("G:G").ColumnWidth = 15
Req2ByWS.Range("J:R").ColumnWidth = 12
Req2ByWS.Range("D:D").ColumnWidth = 12
'## Protect tabs (loop through All Tabs Protect)
'Doit = Protct(True, WB, "Mypassword", Req2ByWS.Name)
'Req2ByWS.Unprotect ("Mypassword")
'Application.Wait (Now + TimeValue("0:00:10"))
Req2ByWS.Select
'## Turn ON Warnings & Screen Updates
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
我愚蠢地为特定 table 启用了后台刷新。刷新所有数据的早期调用触发了刷新，代码将执行，刷新将在代码执行完毕后不久完成……在中断模式下，刷新也将先于完成。感谢 PEH 帮助我调查此事。
我有一个非常奇怪的案例......希望有人能够帮助我，我搜索了很多论坛寻找解决方案，我能找到的最接近的（有点）是 here, 虽然我已经尝试了所有的建议都无济于事…
我正在尝试 运行 一个函数到 return 一个字符串中的数据列表，该字符串由来自 oracle 存储函数的分号分隔。 （这个值函数调用似乎工作正常）。
然后我遍历每个数据值的字符串并将其打印到我的子例程中声明的空白 table （0 行）。我用它来加载到访问数据库中。 （只要相信它在大局中是有意义的……）。
问题，根本上是没有信息打印到table。但是，当我单步执行代码时，它工作正常。
故障排除后，我认为（请参阅代码下方的测试场景）问题出现在 listrows.add 行之后...虽然不是很明显。
我不认为在第一个值试图打印到 table 时执行此行。
最令人困惑的部分是我运行在这部分之前完成了 2 个几乎相同的过程（调用函数 -> Return 值 -> 将值打印到 table）的代码，他们工作没有失败。
代码摘录：
'run function to get string ... this works
DoEvents ' not in original design
RelRtnStr = Prnt(Cat, "A Third Oracle Function Name")
DoEvents ' not in original design
RelChopVar = RelRtnStr
StrFldCnt = 0
Checking = True ''' CodeBreak Test 1
DoEvents ' not in original design
AppendRlLmTbl.ListRows.Add ''''''''This isn't appearing to work...
DoEvents ' not in original design
Debug.Print Now ' not in original design
Application.Wait (Now + TimeValue("0:00:3")) ' not in original design
Debug.Print Now ' not in original design
While StrFldCnt < 80 And (Len(RelChopVar) - Len(Replace(RelChopVar, ";", ""))) > 0 And Checking
'## Count String Position
StrFldCnt = StrFldCnt + 1
'## Find Current String Value & Remainder String
If InStr(RelChopVar, ";") <> 0 Then
'Multiple Values Left
FldVal = Replace(Left(RelChopVar, InStr(RelChopVar, ";")), ";", "")
RelChopVar = Right(RelChopVar, Len(RelChopVar) - InStr(RelChopVar, ";"))
Else
'Last Value
FldVal = RelChopVar
Checking = False
End If
'## Get Field Name For Current Value & Print to Table
FldNm = CStr(RefRtrn(2, CStr(StrFldCnt))) ''' CodeBreak Test 2
AppendRlLmTbl.ListColumns(FldNm).DataBodyRange.Value = FldVal '''CodeBreak 2 error thrown
Debug.Print StrFldCnt & FldNm & FldVal
Wend
AppendRlLmTbl.ListColumns("Catalogue").DataBodyRange.Value = Cat
到目前为止，我已经测试了网上建议的大量选项，不一定理解每个测试...这就是我收集到的内容。
如果我单步执行代码，它会起作用
如果我在 "CodeBreak Test 1" 和 "F5" 其余位置设置断点，它会工作......
如果我在 "CodeBreak Test 2" 处设置断点，我会抛出“未设置变量的对象”错误...
我尝试过的事情……
用
DoEvents包装任何东西
在
listObjects.add行后设置等待时间验证代码在 运行 宁 "full procured" 时执行 While 循环（而不是单步执行）
最糟糕的是，我不知道为什么在添加行行之后设置断点时对象无法正确声明，但在之前设置断点时正确设置并且在 [=85= 时没有抛出错误] 完整的程序（我没有错误声明。）...
它当然在我看来一定是相关的，但我在网上找不到任何信息，不幸的是，我没有正式的 VBA 背景和 1 个本科课程作为一般的编程背景。也就是我超出了我的深度并且非常沮丧。
PS。首先 post，所以请保持友好 :p
完整代码如下：
Option Explicit
'## Here's my attempt to clean up and standardize the flow
'## Declare my public variables
' WorkBook
Public WB As Workbook
' Sheets
Public Req2ByWS As Worksheet
Public ReqSpecsWS As Worksheet
Public ReqInstrcWS As Worksheet
Public ConfigReqWS As Worksheet
Public AppendReqWS As Worksheet
Public AppendRlLmWS As Worksheet
' Objects (tables)
Public ReqConfigTbl As ListObject
Public SpecConfigTbl As ListObject
Public CurrRegIDTbl As ListObject
Public AppendReqTbl As ListObject
Public AppendRlLmTbl As ListObject
'## ##
'## Get Data from Tom's Functions ##
Sub GetSpotBuyData()
'## Preliminary Config ##
'## Turn OFF Warnings & Screen Updates
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'## Set global Referances to be used in routine
' WorkBooks
Set WB = Workbooks("MyWb.xlsm")
' WorkSheets
Set Req2ByWS = WB.Sheets("MyWb Pg1")
Set ReqSpecsWS = WB.Sheets("MyWb Pg2")
Set ConfigReqWS = WB.Sheets("MyWb Pg3")
Set AppendReqWS = WB.Sheets("MyWb Pg4")
Set AppendRlLmWS = WB.Sheets("MyWb Pg5")
' Tables
Set ReqConfigTbl = ConfigReqWS.ListObjects("MyWS Tbl1")
Set SpecConfigTbl = ConfigReqWS.ListObjects("MyWS Tbl2")
Set CurrRegIDTbl = ConfigReqWS.ListObjects("MyWS Tbl3")
Set AppendReqTbl = AppendReqWS.ListObjects("MyWS Tbl4")
Set AppendRlLmTbl = AppendRlLmWS.ListObjects("MyWS Tbl5")
'## Declare Routine Specefic Variables
Dim Doit As Variant
Dim Checking As Boolean
Dim Cat As String
Dim CatRtnStr As String
Dim CatChopVar As String
Dim SpecRtnStr As String
Dim SpecChopVar As String
Dim RelRtnStr As String
Dim RelChopVar As String
Dim FldVal As String
Dim FldNm As String
Dim StrFldCnt As Integer
'## 1) General Set-Up ##
'## Unprotect tabs (loop through All Tabs Unprotect)
Doit = Protct(False, WB, "Mypassword")
'## Refresh Data
Doit = RunUpdateAl(WB)
'## 2) Find the Catalgue we are playing with ##
'## Grab Catalogue input from ISR
If [Catalogue].Value = "" Then
MsgBox ("Please Enter a Catalogue")
GoTo ExitSub
Else
Cat = [Catalogue].Value
End If
'## 3) Run Toms Function and print the results to the form & Append Table ##
'## 3a) Do it for Cat Info Function
'## Get Cat Info String From Function
CatRtnStr = Prnt(Cat, "An Oracle Functions Name")
CatChopVar = CatRtnStr
If CatChopVar = "No Info" Then
MsgBox ("No Info Found in Catalogue Data Search.")
GoTo SkipCatInfoPrint
End If
'## Loop Through Data String & Write to Form
StrFldCnt = 0
Checking = True
AppendReqTbl.ListRows.Add
While Checking
'## Count String Position
StrFldCnt = StrFldCnt + 1
'## Find Current String Value & Remainder String
If InStr(CatChopVar, ";") <> 0 Then
'Multiple Values Left
FldVal = Replace(Left(CatChopVar, InStr(CatChopVar, ";")), ";", "")
CatChopVar = Right(CatChopVar, Len(CatChopVar) - InStr(CatChopVar, ";"))
Else
'Last Value
FldVal = CatChopVar
Checking = False
End If
'## Get Field Name For Current Value & Print to Form
FldNm = CStr(RefRtrn(1, CStr(StrFldCnt)))
If FldNm <> "CustomerSpecification" And FldNm <> "ShiptoAddress" Then
'Take Value as is
Req2ByWS.Range(FldNm).Value = FldVal
AppendReqTbl.ListColumns(FldNm).DataBodyRange.Value = FldVal
ElseIf FldNm = "CustomerSpecification" Then
'Replace : with New Line
FldVal = Replace(FldVal, " : ", vbLf)
Req2ByWS.Range(FldNm).Value = FldVal
AppendReqTbl.ListColumns(FldNm).DataBodyRange.Value = FldVal
ElseIf FldNm = "ShiptoAddress" Then
'Replace - with New Line
FldVal = Replace(FldVal, " - ", vbLf)
Req2ByWS.Range(FldNm).Value = FldVal
AppendReqTbl.ListColumns(FldNm).DataBodyRange.Value = FldVal
End If
Wend
'## 3b) Do it for Spec Function
SkipCatInfoPrint:
'## Get Spec Info String From Function
SpecRtnStr = Prnt(Cat, "Another Oracle Functions Name")
SpecChopVar = SpecRtnStr
If SpecChopVar = "No Info" Then
MsgBox ("No Info Found in Data Search.")
GoTo SkipSpecInfoPrint
End If
'## Loop Through Data String & Write to Form
StrFldCnt = 0
Checking = True
While StrFldCnt < 80 And (Len(SpecChopVar) - Len(Replace(SpecChopVar, ";", ""))) > 0 And Checking
'## Count String Position
StrFldCnt = StrFldCnt + 1
'## Find Current String Value & Remainder String
If InStr(SpecChopVar, ";") <> 0 Then
'Multiple Values Left
FldVal = Replace(Left(SpecChopVar, InStr(SpecChopVar, ";")), ";", "")
SpecChopVar = Right(SpecChopVar, Len(SpecChopVar) - InStr(SpecChopVar, ";"))
Else
'Last Value
FldVal = SpecChopVar
Checking = False
End If
'## Get Field Name For Current Value & Print to Form
FldNm = CStr(RefRtrn(2, CStr(StrFldCnt)))
ReqSpecsWS.Range(FldNm).Value = FldVal
AppendReqTbl.ListColumns(FldNm).DataBodyRange.Value = FldVal
Wend
'## 3c) Do it for Rel Limits Function
SkipSpecInfoPrint:
'## Get Rel Limits String From Function
RelRtnStr = Prnt(Cat, "A Third Functions Name")
RelChopVar = RelRtnStr
If RelChopVar = "No Info" Then
MsgBox ("No Info Found in Data Search.")
GoTo ExitSub
End If
'## Loop Through Data String & Write to Form
StrFldCnt = 0
Checking = True
AppendRlLmTbl.ListRows.Add
While StrFldCnt < 80 And (Len(RelChopVar) - Len(Replace(RelChopVar, ";", ""))) > 0 And Checking
'## Count String Position
StrFldCnt = StrFldCnt + 1
'## Find Current String Value & Remainder String
If InStr(RelChopVar, ";") <> 0 Then
'Multiple Values Left
FldVal = Replace(Left(RelChopVar, InStr(RelChopVar, ";")), ";", "")
RelChopVar = Right(RelChopVar, Len(RelChopVar) - InStr(RelChopVar, ";"))
Else
'Last Value
FldVal = RelChopVar
Checking = False
End If
'## Get Field Name For Current Value & Print to Form
FldNm = CStr(RefRtrn(2, CStr(StrFldCnt)))
AppendRlLmTbl.ListColumns(FldNm).DataBodyRange.Value = FldVal
Wend
AppendRlLmTbl.ListColumns("SpecificFieldName").DataBodyRange.Value = Cat
'## 4) Re-Format and Clean Up Program ##
ExitSub:
'## Clean-Up Formatting
Req2ByWS.Range("F:F", "C:C").ColumnWidth = 30
Req2ByWS.UsedRange.Rows.AutoFit
Req2ByWS.UsedRange.Columns.AutoFit
Req2ByWS.Range("G:G").ColumnWidth = 15
Req2ByWS.Range("J:R").ColumnWidth = 12
Req2ByWS.Range("D:D").ColumnWidth = 12
'## Protect tabs (loop through All Tabs Protect)
'Doit = Protct(True, WB, "Mypassword", Req2ByWS.Name)
'Req2ByWS.Unprotect ("Mypassword")
'Application.Wait (Now + TimeValue("0:00:10"))
Req2ByWS.Select
'## Turn ON Warnings & Screen Updates
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
我愚蠢地为特定 table 启用了后台刷新。刷新所有数据的早期调用触发了刷新，代码将执行，刷新将在代码执行完毕后不久完成……在中断模式下，刷新也将先于完成。感谢 PEH 帮助我调查此事。