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

YZC51

    '===========================加延时
    y = Timer
    Do While Timer - 0.05 < y
         DoEvents
    Loop
   '============================

YZC51

http://club.excelhome.net/thread-1260651-1-1.html
'延时程序
Sub delay(T As Single)
    Dim time1 As Single
    time1 = Timer
    Do
        DoEvents
    Loop While Timer - time1 < T
End Sub
Application.Wait Now + TimeValue("00:00:03")

YZC51

Function Code128(tar)                               '128b码
    Dim s$, i%, SS$, j%, CheckSum%
    s = tar: j = 104: CheckSum = 1                  '开始位的码值为104 mod 103 =1
    For i = 1 To Len(s)
        SS = Mid(s, i, 1)
        j = Asc(SS)                                 '没过滤无效字符,比如汉字.
        If j >= 32 Then j = j - 32 Else: j = j + 64
        CheckSum = (CheckSum + i * j) Mod 103       '校验位
    Next
    If CheckSum < 95 Then CheckSum = CheckSum + 32 Else: CheckSum = CheckSum + 100
    Code128 = ChrW(204) & s & ChrW(CheckSum) & ChrW(206)
End Function

YZC51

Public Sub sds() '区域内空单元格数量
Debug.Print WorksheetFunction.CountIf([a1].Resize(10, 1), "")
End Sub

YZC51

Function 显示公式(rng As Range)
    显示公式 = rng.Formula
End Function

YZC51

Sub jisun() '单元格内文本公式计算
For i = 4 To 100
If Cells(i, 2) <> "" Then
    Cells(i, 5) = "=" & Replace(Cells(i, 4), " ", "")
    Cells(i, 5) = Cells(i, 5).Value
End If
Next
End Sub

Function jisuan(T) '单元格内文本公式计算
    T = Replace(T, " ", "")
    If Len(T) Then jisuan = Evaluate(Replace(T, " ", "")) Else jisuan = ""
End Function

YZC51

五级菜单应用举例！运用坛子的例子，有不同意的可以提出，即刻删除！
20190722五级菜单应用-1.rar (63.21 KB, 下载次数: 74)

2019-7-23 10:35 上传

点击文件名下载附件

YZC51

http://club.excelhome.net/thread-1467934-1-1.html
38楼 ggmmlol 老师的代码。谢谢老师！
自定义的TEXTJOIN函数，与内置的用法完全一致！
Public Function TEXTJOIN(Optional ByVal Delimiter As String = "", Optional ByVal ignore_empty As Boolean = True, Optional ByVal args As Variant) As String    'Variant  '联结文本
    Dim tmptext As Variant, Rng As Variant, cel As Variant
    tmptext = ""
    For Each Rng In args
        If IsArray(Rng) Then
            For Each cel In Rng
                If Len(cel) Or Not ignore_empty Then tmptext = tmptext & Delimiter & cel
            Next cel
        Else
            If Len(Rng) Or Not ignore_empty Then tmptext = tmptext & Delimiter & Rng
        End If
    Next
    TEXTJOIN = Mid(tmptext, Len(Delimiter) + 1)
End Function

ggmmlol

YZC51 发表于 2019-8-2 09:01
http://club.excelhome.net/thread-1467934-1-1.html
38楼 ggmmlol 老师的代码。谢谢老师！
自定义的TEXT ...

楼主大美女啊，你要提示一下点赞的同学们呐：饮水思源，点赞不能只记得“农夫”而忘了“山泉”啊！

YZC51

ggmmlol 发表于 2019-8-2 14:45
楼主大美女啊，你要提示一下点赞的同学们呐：饮水思源，点赞不能只记得“农夫”而忘了“山泉”啊！

老师好幽默！这函数写的很棒！可以2003-2016 通用！！！