用於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