Access中提取电子表格指定行并复制到新表的技术求助

需要过滤一个包含空行和各类报表信息（报表条件、筛选器等）的链接电子表格报表，核心需求是定位Profit Center和Subtotal所在行，通过行号差值创建循环，将两者之间的数据复制到新表并为新表字段分配当前利润中心，具体逻辑：

• 查找Profit Center所在行
• 查找Subtotal所在行
• 计算两行行号差值
• 以差值为循环次数，复制两者之间的行数据到新表
• 为新表记录分配对应的利润中心

目前已实现行定位的VBA代码，但在复制数据到新表时遇到问题，尝试Insert Into、recordset.copy、getrows等方法均出现对象缺失、语法错误或预期语句结束等错误。

Private Sub CaseFunctions(Option_Group)
    Select Case Option_Group
        Case 1301
            MsgBox "Option 1 Selected", vbOKOnly
        Case 1302
            Dim TenderFile_RST As Recordset
            Set DB = CurrentDb
            Set TenderFile_RST = DB.OpenRecordset("Tender Report")

            Dim K As Integer
            Dim Row1 As Integer
            Dim Row2 As Integer
            Dim M As Integer

            K = 0
            M = 0

            Dim Str1 As String
            With TenderFile_RST
                TenderFile_RST.FindFirst "[F1] LIKE '*Profit Center:*'"
                    If TenderFile_RST.NoMatch Then
                        MsgBox "No Profit Center: Found."
                    Else
                        Do While K < 5
                            'Str1 = TenderFile_RST!F1
                            Row1 = TenderFile_RST.AbsolutePosition
                            TenderFile_RST.FindNext "[F1] LIKE '*Subtotal*'"
                            Row2 = TenderFile_RST.AbsolutePosition
                            DiffRow = Row2 - Row1 - 2
                            TenderFile_RST.FindNext "[F1] LIKE '*Profit Center:*'"
                            K = K + 1
                        Loop
                        MsgBox "Reached End of File"
                    End If                      
            End With

        Case 1303
            MsgBox "Option 3 Selected", vbOKOnly
    End Select

End Sub

原代码仅完成了行定位，未正确遍历中间数据行并写入新表。以下是修复后的代码，通过Move方法遍历数据行，使用AddNew/Update写入目标表：

Private Sub CaseFunctions(Option_Group)
    Select Case Option_Group
        Case 1301
            MsgBox "Option 1 Selected", vbOKOnly
        Case 1302
            Dim TenderFile_RST As Recordset
            Dim Target_RST As Recordset
            Dim DB As Database
            Dim ProfitCenterID As String
            Dim endPos As Long
            
            Set DB = CurrentDb
            Set TenderFile_RST = DB.OpenRecordset("Tender Report", dbOpenDynaset)
            Set Target_RST = DB.OpenRecordset("TargetTable", dbOpenDynaset) ' 替换为你的目标表名

            With TenderFile_RST
                .FindFirst "[F1] LIKE '*Profit Center:*'"
                If .NoMatch Then
                    MsgBox "未找到Profit Center记录。"
                    Exit Sub
                End If
                
                Do Until .EOF
                    ' 提取利润中心ID
                    ProfitCenterID = Mid(!F1, InStr(!F1, "(") + 1, InStr(!F1, ")") - InStr(!F1, "(") - 1)
                    
                    ' 定位Subtotal行并记录结束位置
                    .FindNext "[F1] LIKE '*Subtotal*'"
                    If .NoMatch Then Exit Do
                    endPos = .AbsolutePosition - 1 ' 取Subtotal前一行的位置
                    
                    ' 回到当前Profit Center行，跳过表头行
                    .MoveFirst
                    .FindFirst "[F1] LIKE '*Profit Center:*'"
                    .Move 2 ' 跳过Profit Center行和表头行
                    
                    ' 遍历中间数据行并写入目标表
                    Do While .AbsolutePosition <= endPos And Not .EOF
                        Target_RST.AddNew
                        ' 赋值利润中心字段，替换为目标表实际字段名
                        Target_RST!ProfitCenter = ProfitCenterID
                        ' 复制各列数据，根据实际字段对应调整
                        Target_RST!TenderID = !F1
                        Target_RST!TenderType = !F2
                        Target_RST!Quantity = !F3
                        Target_RST!TenderAmount = !F4
                        Target_RST!ChangeAmount = !F5
                        Target_RST!TendersLessChange = !F6
                        Target_RST!PercentOfTotal = !F7
                        Target_RST!Breakage = !F8
                        Target_RST!NetTenders = !F9
                        Target_RST!CurrencyReceived = !F10
                        Target_RST.Update
                        
                        .MoveNext
                    Loop
                    
                    ' 查找下一个Profit Center
                    .FindNext "[F1] LIKE '*Profit Center:*'"
                Loop
            End With
            
            ' 清理资源
            TenderFile_RST.Close
            Target_RST.Close
            Set TenderFile_RST = Nothing
            Set Target_RST = Nothing
            Set DB = Nothing
            
            MsgBox "数据处理完成。"
        Case 1303
            MsgBox "Option 3 Selected", vbOKOnly
    End Select
End Sub

关键修改说明 #

1. 新增目标表操作：打开目标表记录集，用于写入处理后的数据
2. 提取利润中心ID：通过字符串截取从Profit Center:(XX)中提取ID值
3. 精确遍历数据行：定位数据起始行（跳过表头），循环到Subtotal前一行
4. 写入目标表：使用AddNew创建新记录，赋值后Update保存
5. 资源释放：处理完成后关闭并释放所有记录集对象

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