excel函数和宏

f_value #单元格内容转为公式并计算值

Function f_value(ff as variant) 
    f_value = Application.Evaluate("=" & ff) 
End Function

f_bin2dec #二进制转十进制

Function f_bin2dec (rng as Range,sign_flag As String) 
    If ( Left(rng,1) = "1"  And sign_flag = "1" ) Then
        For i = 2 To Len(rng)
            s = s + Mid（rng,i,1）* 2  ^  ( Len(rng)-i )
        Next
        f_bin2dec = s - 2 ^ ( Len(rng)-1 )
    Else
        For i = 1 To Len(rng)
            s = s + Mid（rng,i,1）* 2  ^  ( Len(rng)-i )
        Next
        f_bin2dec = s
    End if
End function

f_hex2bin #十六进制转二进制

Function f_hex2bin (num As String,wide as Double,sign_flag As String) As String
    Dim value_num As String
    Dim lens As Double
    Dim num_of_4 As Double
    Dim total_array As String
    Dim index As Double
    Dim reserved_array As String
    Dim value_num_head As String
    Dim total_array_ini As String
    '将wide转化为4的倍数
    num_of_4 = Application.WorksheetFunction.RoundUp(wide/4,0)
 
    'check字符数目
    lens = Len(num)
    value_num_head = Left(num,1)
 
    'Remove 16进制的“0x”字符，若存在，lens需要减去“0x”
    If ( InStr(num,"x") <> 0 ) Then
        value_num = Mid(num,3,lens)
        lens = lens - 2
    Else
        value_num = num
        lens = lens
    End If 
    If ( lens < num_of_4 ) Then
        For index = 1 To num_of_4 - lens
            If(value_num_head = "8" And sign_flag = "1" ) Then
                value_num = "F" + value_num
            Else
                value_num = "0" + value_num
            End If
        Next index
    Else
        value_num = value_num
    End If 
 
    lens = num_of_4
 
    For index = 1 To num_of_4
        total_array = Application.WorksheetFunction.Hex2Bin(Mid(value_num,lens,1),4) + total_array
        lens = lens - 1
    Next index
 
    f_hex2bin = Right(total_array,wide)
End function

macro_creat_row_grp #按照空白单元格的个数创建行组

Sub macro_creat_row_grp ()
ActiveSheet.Rows.ClearOutline
Application.ScreenUpdating = False
For i = 1 To 6
    For j = 1 To 2 
        If （ Cells(i,j) = "" ） Then
            Rows(i).Select
            Selection.Rows.Group
        Else
            Exit For
        End If
    Next
Next
Application.ScreenUpdating = True
End Sub

macro_creat_8blank_row_grp #按照8个空白单元格的个数创建2级行组

Sub macro_creat_8blank_row_grp ()
ActiveSheet.Rows.ClearOutline
Application.ScreenUpdating = False
For i = 1 To 6
    flag = 0
    For j = 1 To 8
        flag = 0
        If （ Cells(i,j) = "" ） Then
            flag = 1
            Exit for
        End If
        Next
        If （ flag = 0 ） Then
            Rows(i).Select
            Selection.Rows.Group
        End If
    Next
Next
Application.ScreenUpdating = True
End Sub