vba - ListRows.Add 似乎不起作用

Question

我遇到了一个非常奇怪的案例……希望有人能够帮助我，我搜索了很多论坛来寻找解决方案，我能找到的与之相关的最接近的(有点)是 here ，虽然我已经尝试了所有的建议都无济于事......

我正在尝试运行一个函数，以从 Oracle 存储函数中返回以分号分隔的字符串中的数据列表。 (这个值函数调用似乎工作正常)。
然后，我循环遍历每个数据值的字符串，并将其打印到子例程中声明的空白表(0 行)中。我用它来加载到访问数据库中。 (只要相信它在大局中是有意义的......)。

问题的根本在于表格中没有打印任何信息。但是，当我单步执行代码时，它工作正常。

故障排除后，我认为(请参阅下面的代码测试场景)问题出现在 listrows.add 行之后......尽管并不明显。我认为当第一个值尝试打印到表时，该行不会被执行。

最令人困惑的部分是我在这部分代码之前运行了 2 个几乎相同的过程(调用函数 -> 返回值 -> 将值打印到表)，并且它们不会失败。

代码摘录:

'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

到目前为止，我已经测试了网上建议的大量选项，但不一定理解每个测试......这就是我收集到的内容。

1. 如果我单步执行代码，它就会起作用

2. 如果我在“CodeBreak Test 1”和“F5”其余部分设置断点，它就会起作用......

3. 如果我在“CodeBreak Test 2”处设置断点，则会抛出“对象未设置变量”错误...

我尝试过的事情......

1. 用 DoEvents 包装所有内容

2. 在 listObjects.add 行之后设置等待时间

3. 验证代码在运行“完全采购”时执行 While 循环(而不是逐步执行)

最糟糕的部分，我不知道为什么在添加行行之后设置断点时对象不会正确声明，但在之前设置断点时设置正确并且在运行完整过程时没有抛出错误(我没有错误声明。)...

它当然在我心中一定是相关的，但我在网上找不到任何信息，不幸的是我没有正式的 VBA 背景，也没有 1 门本科类(class)作为一般的编程背景。又名我超出了我的深度并且非常沮丧。

PS。第一次发帖，请多多关照: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

Answer 1

我愚蠢地为该特定表启用了后台刷新。早期调用刷新所有数据会触发刷新，代码将执行，并且刷新将在代码执行完毕后不久最终完成......在中断模式下，刷新也会提前完成。感谢 PEH 帮助我调查这个问题。