PrivateSub Command1_Click() Dim sxlApp As Excel.Application Dim sxlBook As Excel.Workbook Dim sxlSheet As Excel.Worksheet '打开EXCEL文件 Dim dxlApp As Excel.Application Dim dxlBook As Excel.Workbook Dim dxlSheet As Excel.Worksheet '打开另一个EXCEL文件 Set sxlApp = CreateObject("Excel.Application") Set sxlBook = sxlApp.Workbooks.Open("d:\source.xls") '打开source.xls sxlApp.Visible =True Set dxlApp = CreateObject("Excel.Application") Set dxlBook = sxlApp.Workbooks.Open("d:\dest.xls") '打开dest.xls dxlApp.Visible =True Set sxlSheet = sxlBook.Worksheets(1) sxlSheet.Activate Set dxlSheet = dxlBook.Worksheets(1) dxlSheet.Activate Dim i%, j%, k% Dim d AsString, s AsString For i = 148 To 220 '在dest中遍历 d = dxlSheet.Cells(i, 2) For j = 2 To 480 s = sxlSheet.Cells(j, 4) If s = d Then For k = 5 To 35 dxlSheet.Cells(i, k)= dxlSheet.Cells(i, k)+ sxlSheet.Cells(j, k + 8) Next k 'ExitFor EndIf Next j Next i MsgBox "write OK!" EndSub