vba校对统计不同工作薄（2）

Option Explicit

Sub Find()
Dim myWorkbook As Workbook
Dim ws As Worksheet
Dim rg As Range, rg2 As Range
Dim rgFirst As Range
Dim nLength As Integer, i As Integer
Dim strTmp As String
Dim strFilePath As String '第三方2文件夹中导入xml文件名
Dim nNum As Integer  '销售件数
Dim s() As String
'nLength = 0
strTmp = ""
On Error GoTo errEx

Set rgFirst = Cells(ActiveCell.Row, ActiveCell.Column)

Do While rgFirst.Value <> ""  '*************循环**********************************

nLength = 0
strTmp = rgFirst.Value

s() = Split(strTmp, ".")
If UBound(s) <> 1 Then
    MsgBox (strTmp & "选择有误！")
    Exit Sub
End If
strTmp = "2013-" & s(0) & "-" & s(1)

Set ws = ThisWorkbook.Sheets(3)
ws.Columns("E:E").NumberFormatLocal = "yyyy-m-d"
ws.Columns("G:G").NumberFormatLocal = "yyyy-m-d"
Set rg2 = ws.Cells(rgFirst.Row, 1)
rg2 = s(0)
rg2.Offset(0, 1) = rgFirst.Offset(0, 1)  '发货地
rg2.Offset(0, 4) = strTmp                '发货日期
rg2.Offset(0, 7) = rgFirst.Offset(0, 3)  '发货件数
rg2.Offset(0, 12) = rgFirst.Offset(0, 4)

'strFilePath = ThisWorkbook.Path & "/四川科伦每天销售发货明细.xls"
'nNum = rgFirst.Offset(0, 2)

Set myWorkbook = Workbooks.Item("四川科伦每天销售发货明细.xls")
'Set myWorkbook = ActiveWorkbook

For i = 2 To myWorkbook.Sheets.Count '''''''''''

Set ws = myWorkbook.Worksheets(i)
Set rg = ws.Cells(1, 1)
Do While rg.Row <> ws.UsedRange.Rows.Count + ws.UsedRange.Row - 1 + 1
   If InStr(rg.Offset(0, 4).Value, rg2.Offset(0, 1)) > 0 And _
   rg.Offset(0, 8).Value = rg2.Offset(0, 4) And _
   rg.Offset(0, 5).Value = rg2.Offset(0, 7) Then

        rg2.Offset(0, 2) = rg.Offset(0, 4) '收货地详细地址
        rg2.Offset(0, 3) = rg.Offset(0, 3)  '收货单位
        rg2.Offset(0, 5) = rg.Offset(0, 1)  '发货单号
        rg2.Offset(0, 6) = rg.Offset(0, 0)  '单据日期
        Exit For
    End If
    Set rg = rg.Offset(1, 0)
Loop

Next ''''''''''''''''''''''''''

  If rg.Row = ws.UsedRange.Rows.Count + ws.UsedRange.Row Then
    MsgBox strTmp & "销售单没找到！可能错误！"
     rg2.EntireRow.Interior.Color = 65535
     Exit Sub
  End If

  Set rgFirst = rgFirst.Offset(1, 0)
  rgFirst.Select
  
Loop          ' *************循环**********************************

  Exit Sub
errEx:
 MsgBox (strTmp & "的执行有错误，请检查！")
End Sub

Sub Macro1()
Application.OnKey "^+g", "Find"
End Sub