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

zqy19912006

YZC51 发表于 2018-11-4 11:31
附件升级啦！

大神  不太看得懂  我就想问问 我的时间是从A3行开始的 要改那个参数

YZC51

函数DLooku加入易失性        Application.Volatile

YZC51

解析json格式函数 作者：lsdongjh 老师
http://club.excelhome.net/thread-1460851-1-1.html

Function GetJson(strJson As String) As String
   
    Dim objHTML As Object, objWin As Object
    Dim lngCount As Long, lngID As Long, strResult As String
   
    Set objHTML = CreateObject("htmlfile")
    Set objWin = objHTML.parentWindow
   
    objWin.execScript "var json = " & strJson, "JScript"
   
    lngCount = objWin.eval("json.length")
    For lngID = 0 To lngCount - 1
        strResult = strResult & " " & objWin.eval("json[" & lngID & "].text")
    Next

    GetJson = strResult
End Function

YZC51

正则解析json格式 作者：teller 老师
http://club.excelhome.net/thread-1460851-1-1.html

Sub RegMultiDeliminator()
    Set reg = CreateObject("vbscript.regexp")
    reg.Pattern = """:""(.*?)"""
    reg.Global = True
    For Each c In Range("A2:A3")
        s = ""
        Set mh = reg.Execute(c.Value)
        For j = 0 To mh.Count - 1
            s = s & " " & mh(j).submatches(0)
        Next
        c.Offset(0, 1).Value = Trim(s)
    Next
End Sub

YZC51

http://club.excelhome.net/forum. ... 260651&typeid=9
原来老师的帖子地址
'延时程序
Sub delay(T As Single)
    Dim time1 As Single
    time1 = Timer
    Do
        DoEvents
    Loop While Timer - time1 < T
End Sub

YZC51

原帖http://club.excelhome.net/thread-1418722-1-1.html

由於Alt鍵是被預設用來關聯選項卡的按鍵，建議將快速鍵Alt+2改成Ctrl+2。
執行SetUpKey即可用Ctrl+1及Ctrl+2分別在B1及C1寫入數字。

Sub 宏1()
        Cells(1, 2) = 5
End Sub

Sub 宏2()
        Cells(1, 3) = 15
End Sub

Sub SetUpKey()
        With Application
                .OnKey "^1", "宏1"
                .OnKey "^2", "宏2"
        End With
End Sub

YZC51

http://club.excelhome.net/thread-189115-1-1.html
10楼 yanjie 老师的代码
sub 最后行数()
dim rng as range
dim r as long
set rng=activesheet.usedrange
r=rng.rows.count
msgbox r
end sub

YZC51

Sub 调整表格宽度()'WORD表格用
Dim myTable As Table
For Each myTable In ActiveDocument.Tables
    myTable.PreferredWidthType = wdPreferredWidthPercent
    myTable.PreferredWidth = 100
Next
End Sub

YZC51

http://club.excelhome.net/thread-1477077-1-1.html
取自5楼老师的代码，谢谢老师！
Function 提取指定字符(Srg As String, Optional n As Integer = 0)
    '提取指定字符（区域,[0数字,1汉字,2字母]）
    Set reg = CreateObject("vbscript.regexp")
    reg.Global = True
    reg.Pattern = Split("\D [^一-龥] [^a-zA-Z]")(n)
    提取指定字符 = reg.Replace(Srg, "")
End Function

YZC51

冻结所有工作表和簿的第一行
http://club.excelhome.net/forum. ... ead&tid=1420510
Sub X()
Dim wt As Worksheet
For Each wt In Worksheets
    wt.Activate
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True
Next
End Sub