使用VBA基于主键匹配两个工作表数据时出现错误91求助

先搞定你调试时的核心报错问题 #

你高亮的那行lgfindRow = ThisWorkbook.Sheets("Labeltexte").Columns(1).Find(...).row踩了VBA查找的典型陷阱：当strPIN在Labeltexte表的第一列找不到匹配项时，Find方法会返回Nothing，这时候直接访问.row会触发运行时错误。必须先判断查找结果是否存在，再进行后续操作。

修复后的完整VBA代码 #

Sub MatchData()
    Dim datasheet As Worksheet
    Dim lgCount As Long
    Dim lastRow As Long ' 把Integer改成Long，避免行数超过32767时溢出
    Dim strPIN As String
    Dim currentCol As Integer
    Dim checkOffset As Integer
    Dim cancelLoop As Integer
    Dim findResult As Range ' 先存查找结果，再判断是否存在
    Dim targetRow As Long
    
    Set datasheet = ThisWorkbook.Worksheets("Produktdaten")
    ' 更可靠的获取最后一行方式，避免格式残留导致的错误
    lastRow = ThisWorkbook.Sheets("Artikelnummern").Cells(Rows.Count, 1).End(xlUp).Row
    
    For lgCount = 1 To lastRow
        currentCol = 3
        checkOffset = 1
        cancelLoop = 0
        strPIN = ThisWorkbook.Sheets("Artikelnummern").Cells(lgCount, 1).Value
        
        ' 复制Artikelnummern的前两列到目标表
        datasheet.Cells(lgCount, 1).Value = strPIN
        datasheet.Cells(lgCount, 2).Value = ThisWorkbook.Sheets("Artikelnummern").Cells(lgCount, 2).Value
        
        ' 关键：先执行查找，判断是否找到匹配项
        Set findResult = ThisWorkbook.Sheets("Labeltexte").Columns(1).Find( _
            What:=strPIN, _
            LookAt:=xlWhole, _
            LookIn:=xlValues, _
            MatchCase:=True)
        
        If Not findResult Is Nothing Then ' 找到匹配才继续处理
            targetRow = findResult.Row
            ' 循环查找后续非空行（调整逻辑：直到遇到空单元格或达到取消次数）
            Do Until ThisWorkbook.Sheets("Labeltexte").Cells(targetRow + checkOffset, 1).Value = "" Or cancelLoop = 10
                checkOffset = checkOffset + 1
                cancelLoop = cancelLoop + 1
            Loop
            ' 复制对应的分配数据到目标表
            For currentOffset = 0 To checkOffset - 1
                datasheet.Cells(lgCount, currentCol).Value = ThisWorkbook.Sheets("Labeltexte").Cells(targetRow + currentOffset, 2).Value
                currentCol = currentCol + 1
            Next currentOffset
        Else
            ' 找不到匹配时标记提示，避免程序崩溃
            datasheet.Cells(lgCount, currentCol).Value = "无匹配PIN"
        End If
    Next lgCount
End Sub

代码优化点说明 #

• 变量类型调整：把intlastRow改为Long，避免Excel行数超过Integer最大值（32767）时的溢出错误
• 查找结果判断：新增findResult变量存储查找结果，先确认找到匹配再访问行属性，彻底解决报错
• 最后一行获取：用Cells(Rows.Count,1).End(xlUp).Row替代UsedRange方式，避免旧格式残留导致的错误
• 异常处理：增加找不到匹配时的提示逻辑，让程序更健壮

非VBA替代方案：用公式快速实现 #

如果你不想写代码，Excel内置公式更简单高效，推荐两种方案：

方案1：XLOOKUP（适用于Excel 365/2021及以后版本） #

在Produktdaten表的C1单元格输入以下公式，下拉+右拉即可：

=XLOOKUP($A1,Labeltexte!$A:$A,Labeltexte!$B:$B,"无匹配",0)

• 说明：$A1是当前行的PIN，匹配Labeltexte表的A列，返回对应B列数据，找不到显示"无匹配"，0代表精确匹配

方案2：INDEX+MATCH（兼容所有Excel版本） #

在Produktdaten表的C1单元格输入：

=IFERROR(INDEX(Labeltexte!$B:$B,MATCH($A1,Labeltexte!$A:$A,0)),"无匹配")

• 说明：MATCH定位PIN在Labeltexte表A列的位置，INDEX返回对应B列数据，IFERROR处理找不到的情况

如果需要把同一个PIN对应的多行分配数据横向展示，可结合INDEX+SMALL实现：

=IFERROR(INDEX(Labeltexte!$B:$B,SMALL(IF(Labeltexte!$A:$A=$A1,ROW(Labeltexte!$A:$A)),COLUMN(A1))),"")

输入后按Ctrl+Shift+Enter（旧版Excel）或直接回车（365版本），再右拉、下拉即可。

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