Sub LOOKUP_UChur() Dim i As Long '=== sourceWorksheet = 数据源表名称 Dim sourceWorksheet As Worksheet Dim taskWorkSheet As Worksheet Dim bgnTime, endTime As Date '********************************************* ' [1] ------ 数据源表 *** Sheet 名称 Set sourceWorksheet = ThisWorkbook.Worksheets("低保数据") Const swsh_KeyColName = "B" ' 关键列 , 身份证号所在的列名称 Const swsh_BeginRow = 3 ' 开始行号 ' [2] ------ 任务表 *** Sheet 名称 Set taskWorkSheet = ThisWorkbook.Worksheets("扶贫和低保比对") Const twsh_KeyColName = "F" ' 关键列号 , 身份证号所在的列号 Const twsh_BeginRow = 3 ' 开始行号 '********************************************* bgnTime = Now() Dim arrKeyData() As Variant ' 这种声明方式是声明一个动态数组 arrKeyData = sourceWorksheet.Range(swsh_KeyColName & swsh_BeginRow & ":" & swsh_KeyColName & sourceWorksheet.UsedRange.Rows.Count) For i = twsh_BeginRow To taskWorkSheet.UsedRange.Rows.Count Debug.Print "第 ["; i & "]行: 已找到数据:" & taskWorkSheet.Range(twsh_KeyColName & i).Text DoEvents curRow = GetRowNo(arrKeyData, taskWorkSheet.Range(twsh_KeyColName & i).Text) If curRow > 0 Then '[3] ???? ===== 任务表 J --> 数据源 A taskWorkSheet.Range("G" & i) = sourceWorksheet.Range("C" & swsh_BeginRow + (curRow - 1)).Text End If Next i endTime = Now() MsgBox ("任务已完成, 处理所需的时间: " & Application.WorksheetFunction.Text(DateDiff("s", bgnTime, endTime) / 3600 / 24, "[H]:mm:ss") & " 秒 " & vbCrLf _ & "*****************************" & vbCrLf & bgnTime & vbCrLf & endTime) DoEvents End Sub Function GetRowNo(ByRef pArrKeyData As Variant, pFindValue As String) As Long GetRowNo = 0 ' curRow = Application.Match(pFindValue, pArrKeyData, 0) '-- Application.Match 所需的时间比较多 6 秒 '-- 下面的循环方式查找数组 所需的时间 2 秒 If Not (UBound(pArrKeyData) > 0) Then Exit Function Dim j As Long For j = LBound(pArrKeyData) To UBound(pArrKeyData) If Not (IsError(pArrKeyData(j, 1))) Then If pArrKeyData(j, 1) = pFindValue Then GetRowNo = j Exit Function End If End If Next j Exit Function End Function