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

YZC51

M豆包 发表于 2019-12-4 13:37
大神，我下载您的万年历学习，为啥详细事项的单元格里没有公式，想请教一下详细事项应该怎么实现。

欢迎新朋友！请您告知网页地址！

M豆包

YZC51 发表于 2019-12-4 14:29
欢迎新朋友！请您告知网页地址！

http://club.excelhome.net/forum. ... page=13#pid10045291
是您发在这个帖子里123楼的万年历模板，谢谢

YZC51

M豆包 发表于 2019-12-4 15:00
http://club.excelhome.net/forum.php?mod=viewthread&tid=1410016&page=13#pid10045291
是您发在这个帖 ...

详细事项是自动提取纪事表里的C列内容！

YZC51

http://club.excelhome.net/thread-1456223-1-1.html
谢谢老师
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Sub hqckbt() '获取窗口标题
    Dim k As Long, s As String * 255
    Shell "notepad.exe", 2'打开记事本
    Application.Wait Now + TimeSerial(0, 0, 2)
    k = GetForegroundWindow()
    GetWindowText k, s, Len(s)
    Shell "taskkill /f /im notepad.exe"'关闭记事本
    MsgBox "窗口标题: " & s
End Sub

M豆包

YZC51 发表于 2019-12-4 16:50
详细事项是自动提取纪事表里的C列内容！

嗯嗯，可是我下载了您的附件，点击日历，详细事项跳不出来，然后里面没有公式，所以我想请教下公式是怎样的。

YZC51

学习老师的拼音函数。谢谢老师！
http://club.excelhome.net/thread-467126-13-1.html
Option Compare Text '设定字符比较的格式
Function PY1(ByVal rng As Range)
    Dim i%, k%, str$
    str = Replace(rng, "　", "")
    For i = 1 To Len(str)
        If Mid(str, i, 1) >= "吖" Then
            k = 1
            Do Until Mid("八嚓哒妸发旮铪讥讥咔垃妈拿哦妑七然仨他哇哇哇夕丫匝咗", k, 1) >= Mid(str, i, 1)
                k = k + 1
            Loop
            If Mid("八嚓哒妸发旮铪讥讥咔垃妈拿哦妑七然仨他哇哇哇夕丫匝咗", k, 1) = Mid(str, i, 1) Then k = k + 1
            '增加上面一行,修正了含有列表中字符时的错误.
            If k > 26 Then k = 26
            PY1 = PY1 & Chr(64 + k)
        Else
            PY1 = PY1 & Mid(str, i, 1)
        End If
    Next
End Function

YZC51

学习老师的拼音函数。谢谢老师！
http://club.excelhome.net/thread-467126-13-1.html
感觉这个更好些！
Public Function LChin(myStr)
    Dim str$, L$, temp$
    str = Replace(myStr, "　", "")
    dict = [{"吖","a";"八","b";"擦","c";"咑","d";"鵽","e";"发","f";"伽","g";"哈","h";"丌","j";"咔","k";"垃","l";"妈","m";"拿","n";"哦","o";"妑","p";"七","q";"然","r";"仨","s";"他","t";"屲","w";"夕","x";"丫","y";"帀","z"}]
    For i = 1 To Len(str)
        L = Mid$(str, i, 1)
        If L Like "[一-龥]" Then
             temp = temp & Application.Lookup(L, dict)
        Else
             temp = temp & L
        End If
    Next i
    LChin = UCase(temp)
End Function


补充内容 (2020-6-23 12:44):
擦 修改 为 嚓

aecn

这个贴知识点好多

M豆包

YZC51 发表于 2019-12-4 16:50
详细事项是自动提取纪事表里的C列内容！

大神，能否告诉我下详细事项里的公式是怎样的，谢谢

YZC51

M豆包 发表于 2019-12-5 13:07
大神，能否告诉我下详细事项里的公式是怎样的，谢谢

您好！详细事项里没有公式的，是VBA 产生的！