ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
楼主: YZC51

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

  [复制链接]

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-10-28 07:35 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
请参考
自定义函数,文本计算
Function js(t)
    t = Application.Asc(t)
    't = Replace(Replace(t, "(", "("), ")", ")")
    For i = 1 To Len(t)
        bb = Mid(t, i, 1)
        aa = Asc(bb)
        If aa > 39 And aa < 58 Or aa = 94 Then js = js & bb
    Next
    js = Evaluate(js)
End Function

评分

3

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-10-28 16:46 | 显示全部楼层
Function GetUTF$(txt$, x) '群子老师
    For i = 1 To Len(txt)
        t = AscW(Mid(txt, i, 1)): If t < 0 Then t = 65536 + t
        If t < 128 Then GetUTF = GetUTF & Hex(t) Else GetUTF = GetUTF & "e" & Hex(t \ 4096) & Hex((t \ 64) Mod 64 + 128) & Hex(t Mod 64 + 128)
    Next
    If x Then GetUTF = LCase(GetUTF)
End Function

评分

2

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-10-28 17:18 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖最后由 YZC51 于 2018-10-28 17:20 编辑

Function ChrUTF$(txt$) 'Change UTF To Char '来自EH香川群子
    txt = Replace(txt, "%", "")
    For i = 1 To Len(txt)
        t = Val("&H" & Mid(txt, i, 2))
        If t < 128 Then ChrUTF = ChrUTF & Chr(t): i = i + 1 Else ChrUTF = ChrUTF & ChrW(Val("&H" & Mid(txt, i + 1, 1)) * 4096 + (Val("&H" & Mid(txt, i + 2, 2)) - 128) * 64 + Val("&H" & Mid(txt, i + 4, 2)) - 128): i = i + 5
    Next
End Function

评分

2

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-10-29 06:51 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖最后由 YZC51 于 2018-10-29 06:59 编辑

Public Function getPy$(ByVal rng$)
'汉字转拼音首字母,自定义函数:
    Dim i%, pyArr, str$, ch$
    pyArr = [{"吖","A";"八","B";"攃","C";"咑","D";"妸","E";"发","F";"旮","G";"哈","H";"丌","J";"咔","K";"垃","L";"妈","M";"乸","N";"噢","O";"帊","P";"七","Q";"冄","R";"仨","S";"他","T";"屲","W";"夕","X";"丫","Y";"帀","Z"}]
    str = Replace(Replace(rng, " ", ""), " ", "")          '去空格和Tab
    For i = 1 To Len(str)
        ch = Mid(str, i, 1)
        If ch Like "[一-龥]" Then   '如果是汉字,进行转换
            getPy = getPy & Application.Lookup(ch, pyArr)
        Else
            'getPy = getPy & UCase(ch)     '如果不是汉字,直接输出
        End If
    Next
End Function '原帖地址:http://club.excelhome.net/thread-1422261-1-1.html

评分

3

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-11-3 10:32 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
股票日线转为周线.xlsm
股票日线转为周线.rar (164.18 KB, 下载次数: 157)

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-11-3 15:49 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-11-4 11:31 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2018-11-4 11:44 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
YZC51 发表于 2018-7-1 12:00
'命理八字四柱函数
'Pi = 3.1415926535898
Function sizhu(birth As Date, Optional gs As Integer = 0)  ...

老师:这个自定义函数能不能计算下面的问题--比如输入:公历2016年10月16日中午11:40,则显示此时的天干地支?

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-11-4 11:58 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
WYS67 发表于 2018-11-4 11:44
老师:这个自定义函数能不能计算下面的问题--比如输入:公历2016年10月16日中午11:40,则显示此时的天干 ...

应该可以,您试一下吧!

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2018-11-4 12:24 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖最后由 WYS67 于 2018-11-4 12:27 编辑
YZC51 发表于 2018-11-4 11:58
应该可以,您试一下吧!

老师:看了您写的多个自定义函数,就是不明白公式怎样输入,里面的参数都有哪些?最好每个自定义函数都有个实例,这样学起来就容易多了!比如38楼的日期,应该怎样输入:是: =sizhu(公历2016,10,16,11:40)吗?

  所以,如果有了具体实例,才能使我们这些VBA小白们能够轻松运用啊!不然,眼前摆一辆辆性能优异的豪车,却苦于没有使用说明书,不会驾驶,只能当成摆设了!
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-12-25 02:13 , Processed in 0.046338 second(s), 7 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表