批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程
[批处理文件精品]批处理版照片整理器[批处理文件精品]纯批处理备份&还原驱动在线第三方下载
返回列表 发帖

[问题求助] VBS二进制转换成十六进制问题。

  1. Sub 生成数据()
  2.     Sheet1.Unprotect 159790
  3.     Dim s As String
  4.     Dim e As Range
  5.     Dim arr
  6.     Dim ss
  7.     Dim rng As Range
  8.     Dim sss
  9.     Dim keys
  10.     Dim i
  11.     Dim 末尾
  12.     Dim dic中文, dic指令, dic十六进制
  13.     Dim dic
  14.     Set dic = RangeToDic(Sheet4.Range("a1").CurrentRegion)
  15.     Range("a13").Resize(10000, 4).ClearContents
  16.     Range("e13").Resize(10000, 1).Interior.Pattern = xlNone
  17.     If [c2] = "" Then
  18.         MsgBox "未发现数据, 请先导入正确的数据!"
  19.         Sheet1.Protect 159790
  20.         Exit Sub
  21.     End If
  22.     Application.ScreenUpdating = False
  23.     Application.EnableEvents = False
  24.     s = Application.Trim(Range("c2").Value)
  25.     arr = Split(s, " ")
  26.     arr = Transpose2(arr)
  27.     末尾 = Range("$C$3").Value & ""
  28.     末尾 = dic(末尾)
  29.     Set rng = Sheet2.Range(Sheet2.Cells(2, 1), Sheet2.Cells(Sheet2.Range("a65536").End(xlUp).Row, 4))
  30.     Set dic中文 = RangeToDic(rng, 1, 2)
  31.     Set dic指令 = RangeToDic(rng, 1, 3)
  32.     Set dic十六进制 = RangeToDic(rng, 1, 4) '电亮了就显示为有颜色
  33.     ReDim brr(0 To UBound(arr), 1 To 5)
  34.     For i = 0 To UBound(arr)
  35.         brr(i, 1) = i + 1
  36.         brr(i, 2) = Application.Clean(arr(i, 1))
  37.         keys = Left(Application.Clean(arr(i, 1)), 3) & ""
  38.         If dic指令.exists(keys) Then
  39.             brr(i, 3) = dic指令(keys)
  40.             brr(i, 4) = dic中文(keys)
  41.             ''''''''''''''
  42.             If Len(brr(i, 2)) = 4 Then
  43.                 sss = "0" & Right(brr(i, 2), 1)
  44.                 If dic十六进制(keys) And dic十六进制(keys) <> "" Then
  45.                     sss = Application.WorksheetFunction.Bin2Hex(sss)
  46.                     If Len(sss) = 1 Then
  47.                         sss = "0" & sss
  48.                     End If
  49.                 End If
  50.             Else
  51.                 'sss = Right(brr(i, 2), 2)
  52.                 sss = Application.WorksheetFunction.Substitute(brr(i, 2), Left(brr(i, 2), 3), "")
  53.                 If dic十六进制(keys) And dic十六进制(keys) <> "" Then
  54.                     sss = Application.WorksheetFunction.Bin2Hex(sss)
  55.                     If Len(sss) = 1 Then
  56.                         sss = "0" & sss
  57.                     End If
  58.                 End If
  59.             End If
  60.             brr(i, 4) = "/k:4:1003 /b:" & brr(i, 4) & sss & 末尾
  61.             ''''''''''''''
  62.         Else
  63.             brr(i, 5) = 1
  64.             ss = ss + 1
  65.         End If
  66.     Next
  67.     If Sheet5.Range("a9").Value = 1 Then '升序
  68.         brr = ArraySortTwo(brr, 4, SortASC)
  69.         ArrToRange brr, Range("a13")
  70.         i = 0
  71.         For Each e In Range(Cells(13, 5), Cells(Range("c65536").End(xlUp).Row, 5))
  72.             i = i + 1
  73.             e.Offset(0, -4).Value = i
  74.             If e.Value = 1 Then
  75.                 e.Interior.Color = 255
  76.                 e.Value = ""
  77.             End If
  78.         Next
  79.     Else  '默认排序
  80.         ArrToRange brr, Range("a13")
  81.         i = 0
  82.         For Each e In Range(Cells(13, 5), Cells(Range("c65536").End(xlUp).Row, 5))
  83.             If e.Value = 1 Then
  84.                 e.Interior.Color = 255
  85.                 e.Value = ""
  86.             End If
  87.         Next
  88.     End If
  89.     'ArrToRange brr, Range("a13")
  90.     If ss = 0 Then
  91.         MsgBox "生成完毕,数据共有 " & i & " 行"
  92.     Else
  93.         MsgBox "生成完毕,有异常 " & ss & " 处问题"
  94.     End If
  95.     导入数据参数 = False
  96.     Application.ScreenUpdating = True
  97.     Application.EnableEvents = True
  98.     Sheet1.Protect 159790
  99. End Sub
复制代码
代码如上。。如果表格启用二进制转换十六进制。。。数据是十六进制就会能正常运行。但数据已经是二进制的话就会报错。。。。有何办法进行一个判断数据是否已是二进制

没法判断吧?因为十六进制里也有0和1,所以任何二进制的数字都能看作十六进制。

TOP

返回列表