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)
'代替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