下面的宏代码可以把另外一个Excel文件中的某些数据根据本Excel中的某个单元格查找对应的数据并放到本Excel中。

Private Sub ProcessCol(source As Worksheet, ACol As Integer)

   Dim Dest As Worksheet

   Dim fr As Range

   

   Set Dest = ThisWorkbook.Sheets("RING")

   maxrow = Dest.UsedRange.Rows.Count

   

   For i = 2 To maxrow

       Set fr = source.Cells.Find(What:=Dest.Cells(i, ACol), SearchDirection:=xlNext, MatchCase:=False)

       If fr Is Nothing Then

         Set fr = source.Cells.Find(What:=Replace(Dest.Cells(i, ACol), " ", ""), SearchDirection:=xlNext, MatchCase:=False)

       End If

       

       If Not fr Is Nothing Then ' 找到了

         If Dest.Cells(i, ACol + 1) = "" Then

           Dest.Cells(i, ACol + 1) = source.Cells(fr.Row, fr.Column + 5)

         ElseIf Dest.Cells(i, ACol + 1) <> source.Cells(fr.Row, fr.Column + 5) Then

           Debug.Print (Dest.Cells(i, ACol))

           If MsgBox(Dest.Cells(i, ACol) & " price not match, Replace it?" & Chr(13) & _

                     "old: " & Dest.Cells(i, ACol + 1) & ", New: " & source.Cells(fr.Row, fr.Column + 5), _

                     vbQuestion + vbYesNo) = vbYes Then Dest.Cells(i, ACol + 1) = source.Cells(fr.Row, fr.Column + 5)

         End If

       End If

   Next

End Sub

Sub Macro1()

'

' Macro1 Macro

' 宏由 Kingron 录制，时间: 2008-1-8

'

'

   Dim source As Worksheet

   

   Set source = Workbooks("Another.xls").Sheets("sheet1")

   ProcessCol source, 2

   ProcessCol source, 5

End Sub