非常感谢 现在我把用宏写的调用 也上传 请大家指正,注意文件名与附件中的有点差别 Sub Macro1() ' ' Macro1 Macro ' 宏由 xyx 录制,时间: 2008-7-9 '使用说明: ' ' ' Dim i As Long Dim n As Long Dim strNew As String Dim strOld As String Dim iNew As Integer Dim iOld As Integer Dim iCount As Integer '*************************需要手动改动的地方,只需要设置一次**************** '要填写的工作簿,如"5月" strNew = "5月" '要填写的工作簿的"卷烟品牌"的位置 iNew = 4 '要查找的工作簿,如"产品价格" strOld = "产品价格" '要查找的工作簿的"卷烟品牌"的位置 iOld = 2 '执行多少条记录询问一次,默认500条,数字越大,一次执行的时间越长 iCount = 5000 '***************************结束**************************** If strNew = "" Or strOld = "" Or iNew = 0 Or iOld = 0 Then Exit Sub End If If MsgBox("是否执行生成批量数据的宏文件?" & Chr(13) _ & "选择是:执行" & Chr(13) _ & "选择否:不执行", vbYesNo) = vbYes Then For i = 2 To Sheets(strNew).Rows.Count - 1 ' If Sheets(strNew).Cells(i, iNew) = "" Then Exit For End If If (i Mod iCount = 0) Then If MsgBox("已经执行了" + Str(i) + "条,是否继续?" & Chr(13) _ & "选择是:继续进行" & Chr(13) _ & "选择否:退出操作", vbYesNo) = vbNo Then Exit For End If End If For n = 2 To Sheets(strOld).Rows.Count - 1 If Sheets(strOld).Cells(n, iOld) = "" Then Exit For End If If Sheets(strNew).Cells(i, iNew) = Sheets(strOld).Cells(n, iOld) Then If Sheets(strNew).Cells(i, iNew + 1) = Sheets(strOld).Cells(n, iOld + 1) Then Sheets(strNew).Cells(i, iNew + 2) = Sheets(strOld).Cells(n, iOld + 2) Sheets(strNew).Cells(i, iNew + 3) = Sheets(strOld).Cells(n, iOld + 3) Sheets(strNew).Cells(i, iNew + 4) = Sheets(strOld).Cells(n, iOld + 4) Exit For End If End If Next n Next i End If End Sub |