Sub 生成数据()
    Sheet1.Unprotect 159790
    Dim s As String
    Dim e As Range
    Dim arr
    Dim ss
    Dim rng As Range
    Dim sss
    Dim keys
    Dim i
    Dim 末尾
    Dim dic中文, dic指令, dic十六进制
    Dim dic
    Set dic = RangeToDic(Sheet4.Range("a1").CurrentRegion)
    Range("a13").Resize(10000, 4).ClearContents
    Range("e13").Resize(10000, 1).Interior.Pattern = xlNone
    If [c2] = "" Then
        MsgBox "未发现数据, 请先导入正确的数据!"
        Sheet1.Protect 159790
        Exit Sub
    End If
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    s = Application.Trim(Range("c2").Value)
    arr = Split(s, " ")
    arr = Transpose2(arr)
    末尾 = Range("$C$3").Value & ""
    末尾 = dic(末尾)
    Set rng = Sheet2.Range(Sheet2.Cells(2, 1), Sheet2.Cells(Sheet2.Range("a65536").End(xlUp).Row, 4))
    Set dic中文 = RangeToDic(rng, 1, 2)
    Set dic指令 = RangeToDic(rng, 1, 3)
    Set dic十六进制 = RangeToDic(rng, 1, 4) '电亮了就显示为有颜色
    ReDim brr(0 To UBound(arr), 1 To 5)
    For i = 0 To UBound(arr)
        brr(i, 1) = i + 1
        brr(i, 2) = Application.Clean(arr(i, 1))
        keys = Left(Application.Clean(arr(i, 1)), 3) & ""
        If dic指令.exists(keys) Then
            brr(i, 3) = dic指令(keys)
            brr(i, 4) = dic中文(keys)
            ''''''''''''''
            If Len(brr(i, 2)) = 4 Then
                sss = "0" & Right(brr(i, 2), 1)
                If dic十六进制(keys) And dic十六进制(keys) <> "" Then
                    sss = Application.WorksheetFunction.Bin2Hex(sss)
                    If Len(sss) = 1 Then
                        sss = "0" & sss
                    End If
                End If
            Else
                'sss = Right(brr(i, 2), 2)
                sss = Application.WorksheetFunction.Substitute(brr(i, 2), Left(brr(i, 2), 3), "")
                If dic十六进制(keys) And dic十六进制(keys) <> "" Then
                    sss = Application.WorksheetFunction.Bin2Hex(sss)
                    If Len(sss) = 1 Then
                        sss = "0" & sss
                    End If
                End If
            End If
            brr(i, 4) = "/k:4:1003 /b:" & brr(i, 4) & sss & 末尾
            ''''''''''''''
        Else
            brr(i, 5) = 1
            ss = ss + 1
        End If
    Next
    If Sheet5.Range("a9").Value = 1 Then '升序
        brr = ArraySortTwo(brr, 4, SortASC)
        ArrToRange brr, Range("a13")
        i = 0
        For Each e In Range(Cells(13, 5), Cells(Range("c65536").End(xlUp).Row, 5))
            i = i + 1
            e.Offset(0, -4).Value = i
            If e.Value = 1 Then
                e.Interior.Color = 255
                e.Value = ""
            End If
        Next
    Else  '默认排序
        ArrToRange brr, Range("a13")
        i = 0
        For Each e In Range(Cells(13, 5), Cells(Range("c65536").End(xlUp).Row, 5))
            If e.Value = 1 Then
                e.Interior.Color = 255
                e.Value = ""
            End If
        Next
    End If
    'ArrToRange brr, Range("a13")
    If ss = 0 Then
        MsgBox "生成完毕,数据共有 " & i & " 行"
    Else
        MsgBox "生成完毕,有异常 " & ss & " 处问题"
    End If
    导入数据参数 = False
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Sheet1.Protect 159790
End Sub
复制代码