用于excel（或wps）中进行ip处理转换的vbs模块

从网上找到的，有一小点改动

Attribute VB_Name = "模块1"

' 本模块代码来自 http://www.anyweb.co.nz/tutorial/excelip

Option Explicit
Public Const OCTET4 As Double = 256# * 256# * 256# * 256#
Public Const OCTET3 As Double = 256# * 256# * 256#
Public Const OCTET2 As Double = 256# * 256#
Public Const OCTET1 As Double = 256#

Function IPIncrease(inpIP As String, Optional inpStep As Integer) As String
' by oicu: 第二个变量是确定计算后面第几个IP/子网，删了没用到的变量

  Dim i As Integer, j As Integer, k As Integer
  Dim ipComp As Variant
  Dim ipOctets As Variant
  Dim ipMask As Integer
  Dim ipAddress As Double

  ipComp = Split(inpIP, "/")
  k = UBound(ipComp)
  ipMask = 32
  If k = 1 Then
    ipMask = CInt(ipComp(1))
  ElseIf k <> 0 Then
    Return
  End If
  If inpStep = 0 Then inpStep = 1

  ipAddress = ConvertIPToDecimal(ipComp(0))
  ipAddress = ipAddress + inpStep * 2 ^ (32 - ipMask)
  IPIncrease = ConvertDecimalToIP(ipAddress)
  If k = 1 Then IPIncrease = IPIncrease & "/" & ipComp(1)
End Function

Function ConvertIPToDecimal(ByVal inpIP As String) As Double
  Dim retValue As Double
  Dim ipOctets As Variant, ipComp As Variant

  ipComp = Split(inpIP, "/")
  If UBound(ipComp) > 0 Then inpIP = ipComp(0)

  retValue = 0
  ipOctets = Split(inpIP, ".")
  If UBound(ipOctets) = 3 Then
    retValue = OCTET3 * CDbl(ipOctets(0)) + _
               OCTET2 * CDbl(ipOctets(1)) + _
               OCTET1 * CDbl(ipOctets(2)) + _
               CDbl(ipOctets(3))
  End If
  ConvertIPToDecimal = retValue
End Function

Function ConvertDecimalToIP(ByVal inpNum As Double) As String
  Dim ipOctets(3) As String
  Dim tempOctet As Double
  Dim retValue As String

  retValue = ""
  If inpNum < OCTET4 Then
    tempOctet = Int(inpNum / OCTET3)
    ipOctets(0) = CStr(tempOctet)
    inpNum = inpNum - OCTET3 * tempOctet
    tempOctet = Int(inpNum / OCTET2)
    ipOctets(1) = CStr(tempOctet)
    inpNum = inpNum - OCTET2 * tempOctet
    tempOctet = Int(inpNum / OCTET1)
    ipOctets(2) = CStr(tempOctet)
    inpNum = inpNum - OCTET1 * tempOctet
    ipOctets(3) = CStr(Int(inpNum))
    retValue = Join(ipOctets, ".")
  End If
  ConvertDecimalToIP = retValue
End Function

Attribute VB_Name = "模块2"
Option Explicit
' Author: oicu#lsxk.org

'转换点分十进制掩码为bit位数，strmask为字符型掩码，形如255.255.255.0
Function ConvertMaskBit(strMask As String) As String

Dim intMask As Double

intMask = ConvertIPToDecimal(strMask)
ConvertMaskBit = CStr(32 - Log(2 ^ 32 - intMask) / Log(2))

 
End Function


'strIP点分十进制IP，形如192.168.1.0/24，如不带掩码，1返回本身，2认为为32位掩码，3，4，5将返回空
'intcontrol,为0返回子网，1返回掩码，2返回广播地址，3返回子网取小IP，4返回子网最大IP，5返回子网可用地址数
Function SubnetMask(strIP As String, Optional intControl As Integer) As String

    Dim k%
    Dim varComp As Variant
    Dim strSubnet As String
    Dim strMask As String
    Dim intMask As Integer
    Dim strBroadcast As String
    
    Application.Volatile
    
    'Dim buffer As String
    'Dim strHost As String
    'buffer = Trim(strIP)
    'intMask = Mid(buffer, InStr(buffer, "/") + 1, 2)
    'intMask = IIf(intMask > 32, 32, intMask)
    'strHost = Left(buffer, InStr(buffer, "/") - 1)

    varComp = Split(Trim(strIP), "/")
    k = UBound(varComp)

    intMask = 32
    If k = 1 Then
        intMask = CInt(varComp(1))
        If intMask > 32 Then intMask = 32
    ElseIf k <> 0 Then
        Return
    End If
    
    strMask = ConvertDecimalToIP(2 ^ 32 - 2 ^ (32 - intMask))
    strSubnet = Subnet(CStr(varComp(0)), strMask)
    strBroadcast = ConvertDecimalToIP(2 ^ (32 - intMask) - 1)
    strBroadcast = Subnet(strSubnet, strBroadcast, 1)

    Select Case intControl
        Case 0  'Subnet
            SubnetMask = strSubnet
        Case 1  'Subnet Mask
            SubnetMask = strMask
        Case 2  'Broadcast
            SubnetMask = strBroadcast
        Case 3  'Min Host IP
            If intMask < 31 Then SubnetMask = IPIncrease(strSubnet, 1)
        Case 4  'Max Host IP
            If intMask < 31 Then SubnetMask = IPIncrease(strBroadcast, -1)
            'SubnetMask = IPIncrease(strSubnet, 2 ^ (32 - intMask) - 2)
        Case 5
            SubnetMask = IIf(intMask < 31, CStr(2 ^ (32 - intMask) - 2), "0")
            'SubnetMask = CStr(WorksheetFunction.Max(2 ^ (32 - intMask) - 2, 0))
    End Select
End Function


' 注意数组大小
' 以前版本当部门超过32767会出错，和intMask无关，是i的问题
Function Dep(strCheckIP As String, DepList As Range) As String
    Dim arrayResult(40000)
    Dim arraySubnet(40000)
    Dim arrayBroadcast(40000)
    Dim varDep As Variant
    ' Dim varComp As Variant
    ' Dim intMask As Integer
    Dim i As Long
    ' Dim k%
    
    Application.Volatile
    
    ' 每一次调用都会循环一次，不要奔溃哦，懒得改了！
    For i = 1 To DepList.Rows.Count
        arrayResult(i) = DepList.Cells(i, 1)
        
        varDep = Trim(DepList.Cells(i, 2))
        
        ' varComp = Split(Trim(DepList.Cells(i, 2)), "/")
        ' k = UBound(varComp)
        ' intMask = 32
        ' If k = 1 Then
        '     intMask = CInt(varComp(1))
        ' ElseIf k <> 0 Then
        '     Return
        ' End If
        ' arraySubnet(i) = CStr(varComp(0))
        ' arrayBroadcast(i) = IPIncrease(CStr(varComp(0)), 2 ^ (32 - intMask) - 1)
        
        arraySubnet(i) = SubnetMask(CStr(varDep), 0)
        arrayBroadcast(i) = SubnetMask(CStr(varDep), 2)

        If ConvertIPToDecimal(strCheckIP) >= ConvertIPToDecimal(arraySubnet(i)) And _
          ConvertIPToDecimal(strCheckIP) <= ConvertIPToDecimal(arrayBroadcast(i)) Then
            Dep = arrayResult(i)
            Exit Function
        ' Else
        '     Dep = "-"   ' IP所属部门找不到默认设为空，需要设别的字符的在这里设
        End If
    Next
End Function

' 我添加的，strcheckIP为要查找的IP，deplist为子网地域范围，depcol为部门所在列，ipcol为子网所在列
Function getDep(strCheckIP As String, DepList As Range, depCol As Integer, ipCol As Integer) As String
    Dim arrayResult(40000)
    Dim arraySubnet(40000)
    Dim arrayBroadcast(40000)
    Dim varDep As Variant
    ' Dim varComp As Variant
    ' Dim intMask As Integer
    Dim i As Long
    ' Dim k%
    
    Application.Volatile
    
    ' 每一次调用都会循环一次，不要奔溃哦，懒得改了！
    For i = 1 To DepList.Rows.Count
        arrayResult(i) = DepList.Cells(i, depCol)
        
        varDep = Trim(DepList.Cells(i, ipCol))
        
        arraySubnet(i) = SubnetMask(CStr(varDep), 0)
        arrayBroadcast(i) = SubnetMask(CStr(varDep), 2)

        If ConvertIPToDecimal(strCheckIP) >= ConvertIPToDecimal(arraySubnet(i)) And _
          ConvertIPToDecimal(strCheckIP) <= ConvertIPToDecimal(arrayBroadcast(i)) Then
            getDep = arrayResult(i)
            Exit Function
         Else
             getDep = ""   ' IP所属部门找不到默认设为空，需要设别的字符的在这里设
        End If
    Next
End Function



Function Subnet(strIP1 As String, strIP2 As String, Optional intControl As Integer) As String
    Dim strSplitIP1() As String
    Dim strSplitIP2() As String
    Dim strResult As String
    Dim i%

    strSplitIP1 = Split(strIP1, ".")
    strSplitIP2 = Split(strIP2, ".")
    'If UBound(strSplitIP1) <> 3 Or UBound(strSplitIP2) <> 3 Then Exit Function
    If intControl = 0 Then
        For i = 0 To 3  ' 十进制可以直接进行逻辑运算
            strResult = strResult & CStr(strSplitIP1(i) And strSplitIP2(i)) & "."
        Next
    ElseIf intControl = 1 Then
        For i = 0 To 3
            strResult = strResult & CStr(strSplitIP1(i) Or strSplitIP2(i)) & "."
        Next
    End If
    Subnet = Left(strResult, Len(strResult) - 1)
End Function

模块3在模块1不可用时代替模块1

Attribute VB_Name = "模块3"
Option Explicit
' Author: oicu#lsxk.org

Function Mask2CIDR(strMask As String) As String
    ' 点分十进制掩码转CIDR掩码
    Dim CIDR As Integer
    Dim varMask As String
    Dim i%
    CIDR = 0
    varMask = IP2Bin(strMask)
    For i = 1 To 32
        CIDR = Mid(varMask, i, 1) + CIDR
    Next
    Mask2CIDR = CIDR
End Function


Function IP2Bin(strIPAddress As String) As String  '将IP转化为32位二进制/8位二进制
    Dim intMod As Integer                          '这个也许还有用，把IP转为二进制表示
    Dim strBin As String
    Dim varIP As Double
    Dim varComp As Variant
    Dim k%
    strBin = ""
    
    ' k = InStrRev(strIPAddress, ".")
    ' k = InStr(strIPAddress, ".")
    varComp = Split(strIPAddress, ".")
    k = UBound(varComp)
    If k = 3 Then
        varIP = ConvertIPToDecimal(strIPAddress)
    Else
        varIP = CDbl(strIPAddress)
    End If
    
    If varIP = 0 Then IP2Bin = CStr(OutZero(32)): Exit Function
    
    Do While varIP <> 1
        'intMod = varIP Mod 2 '取余数Mod及整除\运算时不能超过Long的范围
        intMod = varIP - (Fix(varIP / 2) * 2) '溢出, 换算法
        varIP = Int(varIP / 2) '取整数
        strBin = CStr(intMod) & strBin
    Loop
    IP2Bin = "1" & strBin
    If k = 3 Then
        IP2Bin = OutZero(32 - Len(IP2Bin)) + IP2Bin
    Else
        IP2Bin = Right(String(8, "0") & IP2Bin, 8)
        'IP2Bin = Replace(Space(8 - Len(IP2Bin)), " ", "0") & IP2Bin
    End If
End Function


Function Bin2IP(strBin As String) As String  '将32位二进制数转为IP, 8位二进制转为十进制
    Dim i%, k%
    Dim dblDec As Double
    k = Len(strBin)
    dblDec = 0
    For i = 1 To k
        dblDec = Mid(strBin, i, 1) * 2 ^ (32 - i) + dblDec
    Next
    If k = 32 Then
        Bin2IP = ConvertDecimalToIP(dblDec)
    Else
        Bin2IP = dblDec
    End If
End Function


Function OutZero(intNum As Integer) As String  '输出n个0，上边有2个替代方法
    Dim i%
    OutZero = ""
    If intNum <> 0 Then
        For i = 1 To intNum
            OutZero = OutZero + "0"
        Next
    End If
End Function


Function Subnet2(strIP As String, strMask As String) As String
    Dim i%
    Dim varSubnet As String
    Dim varIP As String
    Dim varMask As String
    varSubnet = ""
    varIP = IP2Bin(strIP)
    varMask = IP2Bin(strMask)
    
    ' vba里超出long范围后没办法按位逻辑与, 换个算法，明显这样很麻烦，不如模块2里直接And得方便
    ' ip地址的每位二进制数与子网掩码的每位二进制数相乘
    For i = 1 To 32
        varSubnet = varSubnet & Mid(varIP, i, 1) * Mid(varMask, i, 1)
    Next
    Subnet2 = Bin2IP(varSubnet)
End Function


Function Subnet3(strIP As String, strMask As String) As String
'大于128.0.0.1的IP地址转成十进制后超出long范围, 不能And运算，这个函数不能使用，做反面教材的
    Dim varSubnet As String
    Dim varIP As String
    Dim varMask As String
    varSubnet = ""
    varIP = ConvertIPToDecimal(strIP)
    varMask = ConvertIPToDecimal(strMask)
    Subnet3 = ConvertDecimalToIP(varIP And varMask)
End Function