常用E8函数

 
Function E8_Parameters(name, rng)  '参数表
'查找参数表返回对应值,代替常规设置名称，简化操作
    Set E8_Parameters = rng.Columns(1).Find(what:=name, LookAt:=xlWhole).Offset(0, 1)
End Function
Function E8_UsedRange(sht As Worksheet) '通过最大行来确定使用区域 系统使用区域有时候不准
    Dim endrow, endCol
    On Error Resume Next
    Set E8_UsedRange = Nothing
    endrow = sht.Cells.Find("*", sht.Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row '计算最后一个非空行号
    endCol = sht.Cells.Find("*", sht.Cells(1, 1), xlValues, xlWhole, xlByColumns, xlPrevious).Column '计算最后一个非空列号
    Set E8_UsedRange = sht.Range(sht.[A1], sht.Cells(endrow, endCol))
End Function
Function E8_MaxRange(rng As Range, Optional col = "") As Range '某一起始行区域往下延展的最大 默认按所有列最大行 也可指定参考列
    Dim endrow  'E8_MaxRange([A1:D1],"D").Select
    If col = "" Then col = rng.EntireColumn.Address
    endrow = rng.Columns(col).EntireColumn.Cells.Find("*", rng.Columns(col)(1), xlValues, xlWhole, xlByRows, xlPrevious).Row  '计算工作表的最后一个非空行号
    Set E8_MaxRange = rng.Resize(endrow - rng(1).Row + 1)
End Function
Public Function E8_LastRow(rng As Range) '返回rng所在列的最后行数
    Dim rmax&
    rmax = ActiveSheet.Rows.Count
    E8_LastRow = rng.Worksheet.Cells(rmax, rng.Column).End(xlUp).Row
End Function
Function E8_InStrlist(s, slist) '在一串字符串中检测是否存在
    Dim e
    InStrlist = False
    For Each e In slist
        If InStr(UCase(s), UCase(e)) > 0 Then
            E8_InStrlist = True
            Exit Function
        End If
    Next
End Function
Function E8_Rnd(min, max) '随机返回指定区间的实数
    E8_Rnd = Int((max - min + 1) * Rnd + min)
End Function
Sub E8_Vlookup(r待查 As Range, r源 As Range, r输出 As Range, 结果列, Optional keyCol = 1)
''EXCEL880 QQ80871835 淘宝https://item.taobao.com/item.htm?id=540422380533
'代替Vlookup完成精确查找功能 直接输出源数据中查到的第一列结果果 避免表内公式重复计算
'r输出只需要写起始第一行 结果列数要输出的数据在r源的列号数组如 [{2,3,4}]
 'E8_Vlookup [sheet2!A2:A416865], [sheet1!A1:B966026], [sheet2!B2], [{2}]
    Dim arr, brr, crr, i&, j&, k&, kdic&
    arr = r待查.Value
    brr = r源.Value
    Dim dic
    Set dic = CreateObject("scripting.dictionary")
    For i = 1 To UBound(brr)
        If Not dic.exists(brr(i, keyCol)) And brr(i, keyCol) <> "" Then   '第一次遇到不存在key则加入字典 记录数据源行号
            dic.Add brr(i, keyCol), i
        End If
    Next
    '对比字典查找结果
    crr = r输出.Resize(UBound(arr)).Value
    For i = 1 To UBound(arr)
        If dic.exists(arr(i, 1)) Then
            kdic = dic(arr(i, 1))
            For j = 1 To UBound(结果列)
                crr(i, j) = brr(kdic, 结果列(j))
            Next
        Else
            For j = 1 To UBound(结果列)
                crr(i, j) = ""
            Next
        End If
    Next
    r输出.Resize(UBound(arr)) = crr
End Sub
Sub RngCopyFormat(rng As Range, rngtarget As Range) '复制格式
    rng.Copy
    rngtarget.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = xlCopy
End Sub