VBA代码异常：循环搜索数据表并复制匹配行至另一工作表

我来帮你捋捋这个问题哈！从你给出的代码片段来看，这里有几个常见的坑可能导致你的VBA代码跑不起来，咱们一个个排查解决：

首先先把你提供的代码片段贴出来方便参考：

Dim datasheet As Worksheet 'data copied from
Dim reportsheet As Worksheet 'data copied to
Dim abhaengigkeit As String
Dim finalrow As Integer
Dim i As Integer 'row counter
'sets vars
Set datasheet = Tabelle1
Set reportsheet =...

1. 工作表引用的坑 #

你用Set datasheet = Tabelle1这种方式，是直接引用工作表的代码名称（就是VBA编辑器里属性窗口的(Name)字段），如果这个名称和实际工作表的代码名不匹配，或者工作表被重命名过，肯定会报错。

建议换成更直观不易错的工作表名称引用，比如：

Set datasheet = ThisWorkbook.Worksheets("你的数据源表名")
Set reportsheet = ThisWorkbook.Worksheets("要复制到的结果表名")

另外你代码里Set reportsheet =...明显没写完，一定要给这个变量完成赋值，不然后续操作直接报错。

2. 下拉菜单的值没获取到 #

你定义了abhaengigkeit用来存下拉菜单的选定值，但代码里完全没看到获取这个值的逻辑！这就相当于你要找东西，但连找什么都没说，肯定没法执行。

如果下拉菜单是单元格的数据验证下拉框，可以这样获取值：

'假设下拉菜单在数据源表的A1单元格，根据实际位置修改
abhaengigkeit = datasheet.Range("A1").Value

如果是表单控件的下拉框，则要这么获取：

abhaengigkeit = datasheet.DropDowns("DropDown1").Value

3. 行号变量类型溢出风险 #

你用了finalrow As Integer和i As Integer，但现在Excel的最大行数是1048576，而Integer的最大值只有32767，一旦数据源行数超过这个数，直接就会溢出报错。

把这两个变量改成Long类型就没问题了：

Dim finalrow As Long
Dim i As Long

4. 核心的匹配复制逻辑缺失 #

目前你的代码只做了变量定义和部分赋值，最关键的循环匹配、复制行的逻辑完全没写！这里给你补上核心逻辑示例：

'先找到数据源表的最后一行（假设数据在A列，根据实际列修改）
finalrow = datasheet.Cells(datasheet.Rows.Count, "A").End(xlUp).Row

'循环每一行，匹配后复制（假设表头在第一行，从第二行开始循环）
For i = 2 To finalrow
    '假设要匹配的列是C列，替换成你的目标列
    If datasheet.Cells(i, "C").Value = abhaengigkeit Then
        '复制整行到结果表的下一行
        datasheet.Rows(i).Copy Destination:=reportsheet.Cells(reportsheet.Rows.Count, "A").End(xlUp).Offset(1, 0)
    End If
Next i

另外如果需要每次复制前清空结果表的旧数据（保留表头），可以加这行：

reportsheet.Rows("2:" & reportsheet.Rows.Count).ClearContents

5. 加上错误处理方便排查 #

建议给代码加个错误处理，这样出错时能直接看到具体错误信息，不用瞎猜：

'在代码开头加
On Error GoTo ErrorHandler

'在代码结束前加
Exit Sub
ErrorHandler:
    MsgBox "出错啦！错误代码：" & Err.Number & "，错误信息：" & Err.Description

最后给你整理一个完整的可参考代码：

Sub CopyMatchingRows()
    Dim datasheet As Worksheet 'data copied from
    Dim reportsheet As Worksheet 'data copied to
    Dim abhaengigkeit As String
    Dim finalrow As Long
    Dim i As Long 'row counter
    
    '设置工作表（替换成你的实际表名）
    Set datasheet = ThisWorkbook.Worksheets("数据源")
    Set reportsheet = ThisWorkbook.Worksheets("结果表")
    
    '获取下拉菜单的值（假设在数据源表B1单元格）
    abhaengigkeit = datasheet.Range("B1").Value
    
    '清空结果表旧数据（保留第一行表头）
    reportsheet.Rows("2:" & reportsheet.Rows.Count).ClearContents
    
    '找到数据源最后一行（数据在A列）
    finalrow = datasheet.Cells(datasheet.Rows.Count, "A").End(xlUp).Row
    
    '循环匹配复制
    For i = 2 To finalrow
        '匹配C列的值，替换成你的目标列
        If datasheet.Cells(i, "C").Value = abhaengigkeit Then
            datasheet.Rows(i).Copy Destination:=reportsheet.Cells(reportsheet.Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
    Next i
    
    MsgBox "匹配行复制完成！"
Exit Sub
ErrorHandler:
    MsgBox "出错啦！错误代码：" & Err.Number & "，错误信息：" & Err.Description
End Sub

你可以根据自己的实际表名、列号、下拉菜单位置修改上面的代码，应该就能正常运行了！

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