VBA中Range变量赋值为空，写入RawData工作表触发对象定义错误

问题背景 #

从数据源拉取数据，循环将每组数据写入名为RawData的工作表，依次填充A1:D1、A2:D2等区域。复用原有可用VBA代码后出现异常，报错Application defined or object-defined error，首次触发位置为Sheets("RawData").range(rCurrentCell).value = 。

排查信息 #

• debug.print输出的每个xNode数据均正确，待写入数据无问题
• 打印rFirstCell和rCurrentCell变量结果为空，怀疑问题出在这两个变量的赋值环节
• 最初使用ThisWorkbook.Worksheets引用时出现对象错误，改用ws对象

原初始单元格指针设置代码片段 #

'Set initial values for Range Pointers
 Set rFirstCell = Worksheets("RawData").range("A1")
 Set rCurrentCell = rFirstCell

完整报错代码 #

Sub ReadFromAcumatica()
Dim xmlReq As ServerXMLHTTP60
Dim ws As Worksheet
Dim rFirstCell As Range 'Points to the First Cell in the row currently being updated
Dim rCurrentCell As Range 'Points the the current cell in the row being updated
Dim counter As Integer 'Counts the lines

counter = 0

'Clear Existing Data

 ThisWorkbook.Worksheets("RawData").Cells.Delete

 Set ws = ThisWorkbook.Worksheets("RawData")

 'Set initial values for Range Pointers
 Set rFirstCell = ws.Range("A1")
 Set rCurrentCell = rFirstCell

'Connect to server to pull data.
Set xmlReq = New ServerXMLHTTP60
xmlReq.Open "GET", "https://somewebsite.com", False, "username", "password"
xmlReq.send

Dim xmlStr As String
Dim XPath As String

xmlStr = xmlReq.responseText

' Create document object
Set objDom = CreateObject("Msxml2.DOMDocument.3.0")     '// Using MSXML 3.0

'/* Load XML */
objDom.LoadXML xmlStr
objDom.setProperty "SelectionNamespaces", _
"xmlns:d='http://schemas.microsoft.com/ado/2007/08/dataservices' " & _
"xmlns:m='http://schemas.microsoft.com/ado/2007/08/dataservices/metadata'"

Set xNodes = objDom.getElementsByTagName("m:properties")
    
    For Each xNode In xNodes
        If xNode.ChildNodes.Length <> 1 Then
            Debug.Print xNode.SelectSingleNode("d:OrderNbr").text, xNode.SelectSingleNode("d:InventoryID").text & _
            xNode.SelectSingleNode("d:Description").text, xNode.SelectSingleNode("d:Quantity").text, xNode.SelectSingleNode("d:RequestedOn").text

           'xNode.SelectSingleNode("d:OrderNbr").text
           
            Set rCurrentCell = rCurrentCell.Offset(0, 1) 'move current cell one column right
                Sheets("RawData").Range(rCurrentCell).Value = xNode.SelectSingleNode("d:InventoryID").text
            Set rCurrentCell = rCurrentCell.Offset(0, 1) 'move current cell one column right
                Sheets("RawData").Range(rCurrentCell).Value = xNode.SelectSingleNode("d:Description").text
            Set rCurrentCell = rCurrentCell.Offset(0, 1) 'move current cell one column right
                Sheets("RawData").Range(rCurrentCell).Value = xNode.SelectSingleNode("d:Quantity").text
            Set rCurrentCell = rCurrentCell.Offset(0, 1) 'move current cell one column right
                Sheets("RawData").Range(rCurrentCell).Value = xNode.SelectSingleNode("d:RequestedOn").text
            Set rCurrentCell = rCurrentCell.Offset(1, -4) 'move current to next line
                        
        End If
    Next

End Sub

问题原因与修复方案 #

核心问题 #

1. 单元格引用错误：Sheets("RawData").Range(rCurrentCell)写法错误，Range方法接受地址字符串或Range对象，但嵌套调用Range对象会引发对象定义错误。rCurrentCell已指向RawData工作表的单元格，直接赋值即可。
2. 初始指针偏移错误：首次写入时先执行偏移，导致从B1开始写入，不符合从A1起始的需求。
3. 变量未显式声明：objDom、xNodes、xNode未声明，可能引发隐式类型问题。

修复后的代码 #

Sub ReadFromAcumatica()
    Dim xmlReq As ServerXMLHTTP60
    Dim ws As Worksheet
    Dim rFirstCell As Range ' 指向当前行的第一个单元格
    Dim rCurrentCell As Range ' 指向当前行的当前单元格
    Dim counter As Integer ' 计数行数
    Dim xmlStr As String
    Dim objDom As Object ' 显式声明DOM对象
    Dim xNodes As Object ' 显式声明节点集合
    Dim xNode As Object ' 显式声明单个节点
    
    counter = 0
    
    ' 清除现有数据并绑定工作表对象
    Set ws = ThisWorkbook.Worksheets("RawData")
    ws.Cells.Delete
    
    ' 设置初始单元格指针
    Set rFirstCell = ws.Range("A1")
    Set rCurrentCell = rFirstCell
    
    ' 连接服务器拉取数据
    Set xmlReq = New ServerXMLHTTP60
    xmlReq.Open "GET", "https://somewebsite.com", False, "username", "password"
    xmlReq.send
    
    xmlStr = xmlReq.responseText
    
    ' 加载XML文档
    Set objDom = CreateObject("Msxml2.DOMDocument.3.0")
    objDom.LoadXML xmlStr
    objDom.setProperty "SelectionNamespaces", _
        "xmlns:d='http://schemas.microsoft.com/ado/2007/08/dataservices' " & _
        "xmlns:m='http://schemas.microsoft.com/ado/2007/08/dataservices/metadata'"
    
    Set xNodes = objDom.getElementsByTagName("m:properties")
    
    For Each xNode In xNodes
        If xNode.ChildNodes.Length <> 1 Then
            Debug.Print xNode.SelectSingleNode("d:OrderNbr").Text, _
                xNode.SelectSingleNode("d:InventoryID").Text & _
                xNode.SelectSingleNode("d:Description").Text, _
                xNode.SelectSingleNode("d:Quantity").Text, _
                xNode.SelectSingleNode("d:RequestedOn").Text
            
            ' 直接写入当前单元格，无需嵌套Range调用
            rCurrentCell.Value = xNode.SelectSingleNode("d:InventoryID").Text
            Set rCurrentCell = rCurrentCell.Offset(0, 1) ' 右移一列
            rCurrentCell.Value = xNode.SelectSingleNode("d:Description").Text
            Set rCurrentCell = rCurrentCell.Offset(0, 1)
            rCurrentCell.Value = xNode.SelectSingleNode("d:Quantity").Text
            Set rCurrentCell = rCurrentCell.Offset(0, 1)
            rCurrentCell.Value = xNode.SelectSingleNode("d:RequestedOn").Text
            
            ' 移到下一行的起始位置（A列）
            counter = counter + 1
            Set rCurrentCell = rFirstCell.Offset(counter, 0)
        End If
    Next
End Sub

修复要点说明 #

• 移除Sheets("RawData").Range(rCurrentCell)的错误写法，直接使用rCurrentCell.Value赋值
• 调整写入逻辑，先赋值再偏移单元格，确保每行从A列起始
• 显式声明所有变量，避免隐式类型转换问题
• 改用计数器+初始单元格偏移的方式定位下一行起始，逻辑更清晰，避免偏移计算错误

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