自定义函数--提取单元格内多个被分开的数字

YZC51

'自定义函数：sx() 单元格内按升序排列：
http://club.excelhome.net/thread-193520-1-1.html

Function sx(T_rng As Range)
Dim a() As String
sx = T_rng.Text
s = Len(sx)
ReDim a(1 To s) As String
For i = 1 To s
a(i) = Mid(sx, i, 1)
Next i
For m = 1 To s
For j = 2 To s
If a(j - 1) > a(j) Then
t = a(j - 1)
a(j - 1) = a(j)
a(j) = t
End If
Next j
Next m
sx = ""
For i = 1 To s
sx = sx & a(i)
Next i
End Function
'如果要按降序排列，把代码中的大于号换成小于号即可。

YZC51

自建转置函数
Function TranVariant(ByVal vData As Variant) As Variant
'转置数组
    Dim vNewData As Variant, nRow As Double, nCol As Double
   
    If IsArray(vData) Then
        ReDim vNewData(1 To UBound(vData, 2) - LBound(vData, 2) + 1, 1 To UBound(vData) - LBound(vData) + 1)
        For nRow = 1 To UBound(vNewData)
            For nCol = 1 To UBound(vNewData, 2)
                If Not IsNull(vData(nCol + LBound(vData, 2) - 1, nRow + LBound(vData) - 1)) Then _
                    vNewData(nRow, nCol) = vData(nCol + LBound(vData, 2) - 1, nRow + LBound(vData) - 1)
            Next
        Next
        vData = vNewData
    End If
    TranVariant = vData
End Function
http://club.excelhome.net/thread-1452553-1-1.html
2楼

YZC51

Public yzc
Sub auto_open()                                     '打开文件后每10分钟执行宏
    Application.OnTime Now + TimeValue("00:10:00"), "auto_open"
    If yzc > 0 Then Call bc
    yzc = yzc + 1
    'Sheet2.Cells(yzc, 1) = yzc
End Sub

Sub bc() '保存工作簿
    ThisWorkbook.Save
End Sub

powerremain

YZC51 发表于 2018-9-9 20:56
Function WLOOKUP(X As Range, M As Variant, Optional a = 1, Optional b = 2)
    '比VLOOKUP函数更强大 ...

能上个附件举例子吗

YZC51

powerremain 发表于 2018-12-26 12:43
能上个附件举例子吗

请参考
http://club.excelhome.net/forum. ... p;page=1#pid9770707

powerremain

YZC51 发表于 2018-12-26 12:49
请参考
http://club.excelhome.net/forum.php?mod=viewthread&tid=1453309&page=1#pid9770707

只支持VBA吗？不能直接用吗？

YZC51

可以直接用！

YZC51

获取工作表和簿的名称
Function ShtName(Optional yzc = "") As String
  '  ShtName = ActiveSheet.Parent.FullName                  '工作簿名称可能有路径
    ShtName = ActiveSheet.Name                              '工作表名称
    If yzc <> "" Then ShtName = ActiveSheet.Parent.Name     '工作簿名称
End Function

YZC51

Function F(a1, a2, R) '"扣除节假日的工作日 和 扣除周六周日"
    If a1 = "" Then F = "": Exit Function
    ReDim arr(R(1) To R(R.Count))
    For i = 1 To R.Count
        arr(Int(R(i))) = 1
    Next
    F = Int(a2) - Int(a1)
    On Error Resume Next
    For i = Int(a1) To Int(a2)
        F = F - arr(i)
    Next
End Function

YZC51

扣除节假日的工作日 附件
直接日期相减.zip (14.76 KB, 下载次数: 56)

2019-1-8 12:14 上传

点击文件名下载附件