vba校对不同工作薄中的内容
2013-10-28 18:01
211 查看
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 '销售件数 'nLength = 0 strTmp = "" On Error GoTo errEx Set rgFirst = Cells(ActiveCell.Row, ActiveCell.Column) Do While rgFirst.Value <> "" '*************循环********************************** nLength = 0 strTmp = rgFirst.Value If Right(strTmp, 1) > 9 Then MsgBox (strTmp & "的发货单据号有误!") Exit Sub End If Set ws = ThisWorkbook.Sheets(3) ws.Columns("A:A").NumberFormatLocal = "yyyy-m-d" ws.Columns("H:H").NumberFormatLocal = "yyyy-m-d" Set rg2 = ws.Cells(rgFirst.Row, 1) rg2 = rgFirst.Offset(0, -1) rg2.Offset(0, 1) = rgFirst.Offset(0, -4) rg2.Offset(0, 4) = rgFirst.Offset(0, 7) 'rg2.Offset(0, 7) = rgFirst.Offset(0, 1) 'rg2.Offset(0, 8) = rgFirst.Offset(0, 0) 'rg2.Offset(0, 9) = rgFirst.Offset(0, -2) '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, 2) Do While rg.Row <> ws.UsedRange.Rows.Count + ws.UsedRange.Row - 1 + 1 If rg.Value = rgFirst.Value Then rg2.Offset(0, 7) = rg.Offset(0, -1) rg2.Offset(0, 8) = rg.Offset(0, 0) rg2.Offset(0, 9) = rg.Offset(0, 2) If nNum <> rg.Offset(0, 4).Value Then MsgBox strTmp & "的件数" & rg.Offset(0, 4).Value & "不对!可能错误!" rg2.EntireRow.Interior.Color = 65535 rg2.Offset(0, 3) = rg.Offset(0, 4).Value rg2.Offset(0, 3).Font.Color = -16776961 Exit Sub Else rg2.Offset(0, 3) = nNum End If 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
相关文章推荐
- vba校对统计不同工作薄(2)
- 浏览网页访客和搜索引擎爬虫不同的Agent 内容
- 根据选择显示不同的内容
- 使用语音即时校对输入内容
- 根据下拉框选择变化显示不同内容
- js内容追加样式不同解决方案
- VBA:单元格合并时内容也进行合并
- 在WORD中用VBA实现光标移动与内容选择
- Android 百度地图sdk 标注图marker中可以切换显示不同内容
- Excel文件中核对两个工作表中不同内容
- VBA清除图表内容
- js判断根据锚点显示不同的内容
- 1, 编写程序,当用户在文本框中输入内容之后,单机不同的按钮,能够把文半框中的内容粘贴到文本区中。“重置”按钮实现将文本框和文本区中的内容清空。界面上的文本区只能显示内容,不能让用户输入文本。运行结果
- 用VBA宏从一个工作薄复制内容到另一个工作薄
- VBA创建超链接内容表
- Android分享中,如何过滤指定的应用,并且对不同的分享方式发送不同的内容?
- java List Map数据对比 找出相同和不同的内容
- 鼠标经过标题上显示不同DIV的内容
- 25条提高iOS App性能的技巧和诀窍 (部分内容重新翻译校对)
- QuickReport 报表根据字段值来显示不同内容