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

Attribute VB_Name = "模块1"' 本模块代码来自 http://www.anyweb.co.nz/tutorial/excelipOption 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 IntegerDim ipComp As VariantDim ipOctets As VariantDim ipMask As IntegerDim ipAddress As DoubleipComp = Split(inpIP, "/")k = UBound(ipComp)ipMask = 32If k = 1 ThenipMask = CInt(ipComp(1))ElseIf k <> 0 ThenReturnEnd IfIf inpStep = 0 Then inpStep = 1ipAddress = ConvertIPToDecimal(ipComp(0))ipAddress = ipAddress + inpStep * 2 ^ (32 - ipMask)IPIncrease = ConvertDecimalToIP(ipAddress)If k = 1 Then IPIncrease = IPIncrease & "/" & ipComp(1)
End FunctionFunction ConvertIPToDecimal(ByVal inpIP As String) As DoubleDim retValue As DoubleDim ipOctets As Variant, ipComp As VariantipComp = Split(inpIP, "/")If UBound(ipComp) > 0 Then inpIP = ipComp(0)retValue = 0ipOctets = Split(inpIP, ".")If UBound(ipOctets) = 3 ThenretValue = OCTET3 * CDbl(ipOctets(0)) + _OCTET2 * CDbl(ipOctets(1)) + _OCTET1 * CDbl(ipOctets(2)) + _CDbl(ipOctets(3))End IfConvertIPToDecimal = retValue
End FunctionFunction ConvertDecimalToIP(ByVal inpNum As Double) As StringDim ipOctets(3) As StringDim tempOctet As DoubleDim retValue As StringretValue = ""If inpNum < OCTET4 ThentempOctet = Int(inpNum / OCTET3)ipOctets(0) = CStr(tempOctet)inpNum = inpNum - OCTET3 * tempOctettempOctet = Int(inpNum / OCTET2)ipOctets(1) = CStr(tempOctet)inpNum = inpNum - OCTET2 * tempOctettempOctet = Int(inpNum / OCTET1)ipOctets(2) = CStr(tempOctet)inpNum = inpNum - OCTET1 * tempOctetipOctets(3) = CStr(Int(inpNum))retValue = Join(ipOctets, ".")End IfConvertDecimalToIP = 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 StringDim intMask As DoubleintMask = 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 StringDim k%Dim varComp As VariantDim strSubnet As StringDim strMask As StringDim intMask As IntegerDim strBroadcast As StringApplication.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 = 32If k = 1 ThenintMask = CInt(varComp(1))If intMask > 32 Then intMask = 32ElseIf k <> 0 ThenReturnEnd IfstrMask = 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 intControlCase 0  'SubnetSubnetMask = strSubnetCase 1  'Subnet MaskSubnetMask = strMaskCase 2  'BroadcastSubnetMask = strBroadcastCase 3  'Min Host IPIf intMask < 31 Then SubnetMask = IPIncrease(strSubnet, 1)Case 4  'Max Host IPIf intMask < 31 Then SubnetMask = IPIncrease(strBroadcast, -1)'SubnetMask = IPIncrease(strSubnet, 2 ^ (32 - intMask) - 2)Case 5SubnetMask = 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 StringDim arrayResult(40000)Dim arraySubnet(40000)Dim arrayBroadcast(40000)Dim varDep As Variant' Dim varComp As Variant' Dim intMask As IntegerDim i As Long' Dim k%Application.Volatile' 每一次调用都会循环一次，不要奔溃哦，懒得改了！For i = 1 To DepList.Rows.CountarrayResult(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)) ThenDep = arrayResult(i)Exit Function' Else'     Dep = "-"   ' IP所属部门找不到默认设为空，需要设别的字符的在这里设End IfNext
End Function' 我添加的，strcheckIP为要查找的IP，deplist为子网地域范围，depcol为部门所在列，ipcol为子网所在列
Function getDep(strCheckIP As String, DepList As Range, depCol As Integer, ipCol As Integer) As StringDim arrayResult(40000)Dim arraySubnet(40000)Dim arrayBroadcast(40000)Dim varDep As Variant' Dim varComp As Variant' Dim intMask As IntegerDim i As Long' Dim k%Application.Volatile' 每一次调用都会循环一次，不要奔溃哦，懒得改了！For i = 1 To DepList.Rows.CountarrayResult(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)) ThengetDep = arrayResult(i)Exit FunctionElsegetDep = ""   ' IP所属部门找不到默认设为空，需要设别的字符的在这里设End IfNext
End FunctionFunction Subnet(strIP1 As String, strIP2 As String, Optional intControl As Integer) As StringDim strSplitIP1() As StringDim strSplitIP2() As StringDim strResult As StringDim i%strSplitIP1 = Split(strIP1, ".")strSplitIP2 = Split(strIP2, ".")'If UBound(strSplitIP1) <> 3 Or UBound(strSplitIP2) <> 3 Then Exit FunctionIf intControl = 0 ThenFor i = 0 To 3  ' 十进制可以直接进行逻辑运算strResult = strResult & CStr(strSplitIP1(i) And strSplitIP2(i)) & "."NextElseIf intControl = 1 ThenFor i = 0 To 3strResult = strResult & CStr(strSplitIP1(i) Or strSplitIP2(i)) & "."NextEnd IfSubnet = Left(strResult, Len(strResult) - 1)
End Function

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

Attribute VB_Name = "模块3"
Option Explicit
' Author: oicu#lsxk.orgFunction Mask2CIDR(strMask As String) As String' 点分十进制掩码转CIDR掩码Dim CIDR As IntegerDim varMask As StringDim i%CIDR = 0varMask = IP2Bin(strMask)For i = 1 To 32CIDR = Mid(varMask, i, 1) + CIDRNextMask2CIDR = CIDR
End FunctionFunction IP2Bin(strIPAddress As String) As String  '将IP转化为32位二进制/8位二进制Dim intMod As Integer                          '这个也许还有用，把IP转为二进制表示Dim strBin As StringDim varIP As DoubleDim varComp As VariantDim k%strBin = ""' k = InStrRev(strIPAddress, ".")' k = InStr(strIPAddress, ".")varComp = Split(strIPAddress, ".")k = UBound(varComp)If k = 3 ThenvarIP = ConvertIPToDecimal(strIPAddress)ElsevarIP = CDbl(strIPAddress)End IfIf varIP = 0 Then IP2Bin = CStr(OutZero(32)): Exit FunctionDo While varIP <> 1'intMod = varIP Mod 2 '取余数Mod及整除\运算时不能超过Long的范围intMod = varIP - (Fix(varIP / 2) * 2) '溢出, 换算法varIP = Int(varIP / 2) '取整数strBin = CStr(intMod) & strBinLoopIP2Bin = "1" & strBinIf k = 3 ThenIP2Bin = OutZero(32 - Len(IP2Bin)) + IP2BinElseIP2Bin = Right(String(8, "0") & IP2Bin, 8)'IP2Bin = Replace(Space(8 - Len(IP2Bin)), " ", "0") & IP2BinEnd If
End FunctionFunction Bin2IP(strBin As String) As String  '将32位二进制数转为IP, 8位二进制转为十进制Dim i%, k%Dim dblDec As Doublek = Len(strBin)dblDec = 0For i = 1 To kdblDec = Mid(strBin, i, 1) * 2 ^ (32 - i) + dblDecNextIf k = 32 ThenBin2IP = ConvertDecimalToIP(dblDec)ElseBin2IP = dblDecEnd If
End FunctionFunction OutZero(intNum As Integer) As String  '输出n个0，上边有2个替代方法Dim i%OutZero = ""If intNum <> 0 ThenFor i = 1 To intNumOutZero = OutZero + "0"NextEnd If
End FunctionFunction Subnet2(strIP As String, strMask As String) As StringDim i%Dim varSubnet As StringDim varIP As StringDim varMask As StringvarSubnet = ""varIP = IP2Bin(strIP)varMask = IP2Bin(strMask)' vba里超出long范围后没办法按位逻辑与, 换个算法，明显这样很麻烦，不如模块2里直接And得方便' ip地址的每位二进制数与子网掩码的每位二进制数相乘For i = 1 To 32varSubnet = varSubnet & Mid(varIP, i, 1) * Mid(varMask, i, 1)NextSubnet2 = Bin2IP(varSubnet)
End FunctionFunction Subnet3(strIP As String, strMask As String) As String
'大于128.0.0.1的IP地址转成十进制后超出long范围, 不能And运算，这个函数不能使用，做反面教材的Dim varSubnet As StringDim varIP As StringDim varMask As StringvarSubnet = ""varIP = ConvertIPToDecimal(strIP)varMask = ConvertIPToDecimal(strMask)Subnet3 = ConvertDecimalToIP(varIP And varMask)
End Function