- 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
复制代码 代码如上。。如果表格启用二进制转换十六进制。。。数据是十六进制就会能正常运行。但数据已经是二进制的话就会报错。。。。有何办法进行一个判断数据是否已是二进制 |