• [原]机动车环保检验合格标志核发系统批量处理


    关键字:VBA、Excel、宏、按键精灵、环保标志

    Sub Macro1()
    '机动车环保检验合格标志核发系统 原始数据整理 VBA
    ' Macro1 Macro
    ' 宏由 MS User 录制,时间: 2012-12-6
    '

        '车辆类型
    '    Sheet2.Activate
    '    Dim i As Integer
    '    Dim m As Integer, n As Integer
    '    m = 12
    '    n = 13
    '    For i = 2 To 10000
    '        If Cells(i, m).Value = "K31" Then
    '            Cells(i, n).Value = "小型普通客车"
    '        ElseIf Cells(i, m).Value = "K32" Then
    '            Cells(i, n).Value = "小型越野客车"
    '        ElseIf Cells(i, m).Value = "K33" Then
    '            Cells(i, n).Value = "轿车"
    '         ElseIf Cells(i, m).Value = "K34" Then
    '            Cells(i, n).Value = "小型专用客车"
    '        ElseIf Cells(i, m).Value = "K21" Then
    '            Cells(i, n).Value = "中型普通客车"
    '        ElseIf Cells(i, m).Value = "K11" Then
    '            Cells(i, n).Value = "大型普通客车"
    '        ElseIf Cells(i, m).Value = "H31" Then
    '            Cells(i, n).Value = "轻型普通货车"
    '        ElseIf Cells(i, m).Value = "H32" Then
    '            Cells(i, n).Value = "轻型厢式货车"
    '        ElseIf Cells(i, m).Value = "H33" Then
    '            Cells(i, n).Value = "轻型封闭货车"
    '        ElseIf Cells(i, m).Value = "N11" Then
    '            Cells(i, n).Value = "三轮汽车"
    '        ElseIf Cells(i, m).Value = "Z51" Then
    '            Cells(i, n).Value = "重型专项作业车"
    '        ElseIf Cells(i, m).Value = "K43" Then
    '            Cells(i, n).Value = "微型轿车"
    '        ElseIf Cells(i, m).Value = "H37" Then
    '            Cells(i, n).Value = "轻型自卸货车"
    '        Else
    '            Cells(i, n).Interior.ColorIndex = 3
    '        End If
    '    Next i

    '    '使用性质
    '    Sheet2.Activate
    '    Dim i As Integer
    '    For i = 2 To 10000
    '        If Cells(i, 10).Value = "A" Then
    '            Cells(i, 11).Value = "非营运"
    '        ElseIf Cells(i, 10).Value = "C" Then
    '            Cells(i, 11).Value = "公交"
    '        ElseIf Cells(i, 10).Value = "D" Then
    '            Cells(i, 11).Value = "出租"
    '        Else
    '            Cells(i, 11).Value = "其他"
    '            Cells(i, 11).Interior.ColorIndex = 3
    '        End If
    '    Next i

    '    '燃料
    '    Sheet2.Activate
    '    Dim i As Integer
    '
    '    For i = 2 To 10000
    '        If Cells(i, 6).Value = "A" Then
    '            Cells(i, 7).Value = "汽油"
    '        ElseIf Cells(i, 6).Value = "B" Then
    '            Cells(i, 7).Value = "柴油"
    '        Else
    '            Cells(i, 7).Value = "未知"
    '            Cells(i, 7).Interior.ColorIndex = 3
    '        End If
    '    Next i



    '    '车牌
    '    Sheet2.Activate
    '    Dim i As Integer
    '
    '    For i = 2 To 10000
    '        If Cells(i, 2).Value = "02" Then
    '            Cells(i, 3).Value = "蓝牌"
    '        ElseIf Cells(i, 2).Value = "01" Then
    '            Cells(i, 3).Value = "黄牌"
    '        ElseIf Cells(i, 2).Value = "13" Then
    '            Cells(i, 3).Value = "蓝牌"
    '        '16是教练车 15是半挂
    '        ElseIf Cells(i, 2).Value = "16" Or Cells(i, 2).Value = "15" Then
    '            Cells(i, 3).Value = "黄牌"
    '        Else
    '            Debug.Print i
    '            Cells(i, 3).Interior.ColorIndex = 3
    '        End If
    '    Next i


    ''载客数
    '    Sheet2.Activate
    '    Dim i As Integer
    '
    '    For i = 2 To 10000
    '        If Cells(i, 4).Value = "" Then
    '            Cells(i, 5).Value = 2
    '            Cells(i, 5).Interior.ColorIndex = 3
    '        Else
    '           Cells(i, 5).Value = Cells(i, 4).Value
    '        End If
    '    Next i

    '总质量
        Sheet2.Activate
        Dim i As Integer
        Dim m As Integer
        m = 14

        For i = 2 To 10000
            If Cells(i, m).Value = "" Then
                Debug.Print (i - 1)
                Cells(i, m).Interior.ColorIndex = 3
            End If
        Next i
    End Sub
    '核对导入结果与核发导出结果是否一致:
    Sub Macro1()
    ' 宏由 MS User 录制,时间: 2012-12-24
    ' 快捷键: Ctrl+k
        Sheet2.Activate
        Dim i As Integer
        Dim j As Integer
        Dim m As Integer
        Dim n As Integer
        Dim b As Integer
        m = 1
        n = 2

        Debug.Print "Begin"
        For j = 2 To 2001 '2001
            b = 0
            For i = 2 To 2006 '1995
                If Sheet1.Cells(i, m).Value = Sheet2.Cells(j, n).Value Then
                    b = 1
                    Exit For
                End If
            Next i
            If b = 0 Then Debug.Print j
            If j Mod 100 = 0 Then Debug.Print "=" & j & "========================"
        Next j
        Debug.Print "End"
    End Sub
    '按键精灵
    '复制车牌,2012-12-27
    '使用环境:必须在XP下,核发软件前必须有一个Windows文件夹窗口。

    '==========复制车牌begin==========
    MoveTo 329, 678
    LeftDown 1
    LeftClick 1
    LeftUp 1
    LeftUp 1
    LeftUp 1
    LeftUp 1
    LeftUp 1
    Delay 250
    KeyDown "Ctrl", 1
    Delay 16
    KeyDown "Ctrl", 1
    Delay 375
    KeyDown "C", 1
    Delay 156
    KeyUp "Ctrl", 1
    KeyUp "C", 1
    Delay 16
    KeyUp "C", 1
    MoveTo 627, 759
    'Delay 937
    LeftDown 1
    LeftClick 1
    LeftUp 1
    MoveTo 140, 329
    Delay 200
    LeftDown 1
    MoveTo 57, 329
    Delay 422
    LeftUp 1
    MoveTo 59, 329
    Delay 94
    KeyDown "Ctrl", 1
    MoveTo 118, 329
    Delay 203
    KeyDown "V", 1
    MoveTo 130, 329
    Delay 94
    KeyUp "Ctrl", 1
    MoveTo 139, 329
    Delay 47
    KeyUp "V", 1
    MoveTo 151, 332
    KeyDown "Enter", 1

    '双击记录
    MoveTo 144, 377
    Delay 50
    'LeftDown 1
    LeftDoubleClick 1
    'LeftUp 1

    '==========复制车牌end==========
    '按键精灵
    '功能:核发确认,2012-12-27,快捷键F6
    '使用环境:必须在XP下,核发软件前必须有一个Windows文件夹窗口。

    //==========以下是按键精灵录制的内容==========
    '主程序如下:
    Delay 100
    MoveTo 596, 545
    LeftDown 1
    LeftClick 1
    LeftUp 1
    MoveTo 440, 498
    Delay 2800
    LeftDown 1
    LeftClick 1
    LeftUp 1
    Delay 16
    LeftUp 1
    MoveTo 931, 580
    Delay 210
    LeftDown 1
    LeftClick 1
    LeftUp 1
    MoveTo 768, 438
    Delay 210
    LeftDown 1
    LeftClick 1
    LeftUp 1
    MoveTo 775, 438
    Delay 210
    LeftDown 1
    LeftClick 1
    LeftUp 1
    MoveTo 653, 439
    Delay 210
    LeftDown 1
    LeftClick 1
    LeftUp 1
    MoveTo 792, 435
    Delay 2300
    LeftDown 1
    LeftClick 1
    LeftUp 1
    MoveTo 644, 436
    Delay 250
    LeftDown 1
    LeftClick 1
    LeftUp 1
    MoveTo 734, 767
    Delay 900
    LeftDown 1
    LeftClick 1
    LeftUp 1
    MoveTo 608, 90
    'Delay 100
    LeftDown 1
    LeftClick 1
    LeftUp 1
    'Delay 1000
    KeyDown "Down", 1
    'Delay 47
    KeyUp "Down", 1
    '==========以上是按键精灵录制的内容==========
    '==========复制车牌begin==========
    '复制车牌
    MoveTo 329, 678
    LeftDown 1
    LeftClick 1
    LeftUp 1
    LeftUp 1
    LeftUp 1
    LeftUp 1
    LeftUp 1
    Delay 250
    KeyDown "Ctrl", 1
    Delay 16
    KeyDown "Ctrl", 1
    Delay 375
    KeyDown "C", 1
    Delay 156
    KeyUp "Ctrl", 1
    KeyUp "C", 1
    Delay 16
    KeyUp "C", 1
    MoveTo 627, 759
    LeftDown 1
    LeftClick 1
    LeftUp 1
    MoveTo 140, 329
    Delay 200
    LeftDown 1
    MoveTo 57, 329
    Delay 422
    LeftUp 1
    MoveTo 59, 329
    Delay 94
    KeyDown "Ctrl", 1
    MoveTo 118, 329
    Delay 200
    KeyDown "V", 1
    MoveTo 130, 329
    Delay 90
    KeyUp "Ctrl", 1
    MoveTo 139, 329
    Delay 40
    KeyUp "V", 1
    MoveTo 151, 332
    KeyDown "Enter", 1

    '双击记录
    MoveTo 144, 377
    Delay 50
    LeftDoubleClick 1
    '==========复制车牌end==========
    '按键精灵
    '功能:日期输入,2012-12-27
    '使用环境:必须在XP下,核发软件前必须有一个Windows文件夹窗口。
    '==========以下是按键精灵录制的内容==========
    MoveTo 362, 473
    LeftDown 1
    LeftClick 1
    LeftUp 1


    KeyDown "Num 2", 1

    KeyDown "Num 0", 1

    KeyUp "Num 2", 1

    KeyUp "Num 0", 1

    KeyDown "Num 1", 1

    KeyUp "Num 1", 1

    KeyDown "Num 3", 1

    KeyUp "Num 3", 1

    KeyDown "Tab", 1

    KeyUp "Tab", 1

    KeyDown "Num 1", 1

    KeyUp "Num 1", 1

    KeyDown "Num 2", 1

    KeyUp "Num 2", 1

    KeyDown "Tab", 1

    KeyUp "Tab", 1

    KeyDown "Num 3", 1

    KeyDown "Num 1", 1

    KeyUp "Num 3", 1

    KeyUp "Num 1", 1
    '==========以上是按键精灵录制的内容==========
    '==========按F6==========
    Delay 100
    KeyPress "F6", 1
  • 相关阅读:
    【转发】mysql数据库遇到的故障及分析_连接MySQL数据库时常见故障问题的分析与解决
    ubuntu php 上传文件临时目录,PHP $_FILES 上传文件,在Windows下正常,但在Ubuntu下无法上传文件
    hive从入门到放弃(六)——常用文件存储格式
    手把手教你使用Git管理你的软件代码
    python剪切视频
    分享一个 SpringCloud Feign 中所埋藏的坑
    【转】wireshark分析RDP数据前的设置
    pyshark报错: lxml.etree.XMLSyntaxError: Input is not proper UTF8, indicate encoding !
    vim 配色
    协议层安全相关《http请求走私与CTF利用》
  • 原文地址:https://www.cnblogs.com/wintys/p/vba_env_excel.html
Copyright © 2020-2023  润新知