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

YZC51

上传2020年月历，方便坛友们查询打印！
2020全年日历20191223.rar (318.38 KB, 下载次数: 35)

2019-12-23 20:37 上传

点击文件名下载附件

YZC51

一笔书天地 发表于 2019-12-23 12:56
感谢楼主老师的付出与分享！您辛苦了！

谢谢老师鼓励！！！

YZC51

通达信股票数据
Sub 从通达信取某只股票数据()
    Dim Bs() As Byte
    Dim arr()
    [A:H] = ""
    gpdm = "\" & [l1] & ".day"
'   Open ThisWorkbook.Path & "\sh000001.day" For Binary As #1
    Open ThisWorkbook.Path & gpdm For Binary As #1
    ReDim Bs(1 To LOF(1))
    Get #1, , Bs
    Close #1
    a = 1
    ReDim arr(1 To UBound(Bs) / 4)
    For i = UBound(Bs) / 4 To 1 Step -1
       arr(i) = Bs((i - 1) * 4 + 4) * 16 ^ 6 + Bs((i - 1) * 4 + 3) * 16 ^ 4 + Bs((i - 1) * 4 + 2) * 16 ^ 2 + Bs((i - 1) * 4 + 1)
       B = i Mod 8
       If B = 0 Then B = 8: a = a + 1
       If B = 1 Then arr(i) = Format(arr(i), "0000-00-00")
       Cells(a, B) = arr(i)
    Next i
    [a1:h1] = Split("日期,开盘价,最高价,最低价,收盘价,成交额,成交量,未知", ",")
End Sub

YZC51

通达信5分钟数据
Sub 5分钟数据()
    Range(Cells(2, 1), Cells(10000, 9)).ClearContents
    gpdm = "\" & [l1] & ".lc5"
    Open ThisWorkbook.Path & gpdm For Binary As #1
'    Open ThisWorkbook.Path & "\sh999999.lc5" For Binary As #1
    Dim B() As YFZ, UB
    ReDim B(1 To LOF(1))
    Get #1, , B
    Close #1
    UB = UBound(B) / 32
    ReDim arr(1 To UB, 1 To 9)
    For i = 1 To UB 'ound(B) / 32
        If B(i).RQ < 0 Then xx = B(i).RQ + 65536 Else xx = B(i).RQ
        yy = (xx Mod 2048) / 100
'        Cells(i + 1, 1) = ((Int(xx / 2048) + 2004) & "-" & Int((xx Mod 2048) / 100) & "-" & ((xx Mod 2048) Mod 100))
        arr(i, 1) = (Int(xx / 2048) + 2004) & "-" & Int(yy) & "-" & Int((yy - Int(yy)) * 100)
        arr(i, 2) = Int(B(i).Sj / 60) & Format(B(i).Sj Mod 60, "\:00")
        arr(i, 3) = Val(B(i).KP)
'        arr(i, 3) = Round(Val(B(i).KP), 3)
        arr(i, 4) = Round(Val(B(i).ZG), 3)
        arr(i, 5) = Round(Val(B(i).ZD), 3)
        arr(i, 6) = Round(Val(B(i).SP), 3)
        arr(i, 7) = B(i).JE
        arr(i, 8) = B(i).JL
        arr(i, 9) = B(i).aa
     '   Cells(i + 1, 4) = xx
    Next i
    [a2].Resize(UB, 9) = arr
'    [a1:I1] = Split("日期,时间,开盘价,最高价,最低价,收盘价,成交额,成交量,未知", ",")
End Sub

YZC51

通达信数据附件
通达信股票数据-V1.0.rar (295.98 KB, 下载次数: 18)

2020-1-3 19:07 上传

点击文件名下载附件

YZC51

'四舍六入
Function Yround(c, d)
    If c = 0 Then Yround = 0: Exit Function
    If c > 0 Then m = 1 Else m = -1
    c = Abs(c)
    If d > 6 Then d = 6
    Yround = Val((Round(CDec(c + 10 ^ d), d) - 10 ^ d) * m)
End Function

YZC51

一笔书天地 发表于 2019-12-23 12:56
感谢楼主老师的付出与分享！您辛苦了！

不客气！谢谢老师鼓励！

sxz4494

YZC51 发表于 2018-8-10 03:58
Sub 相片拍照日期()
    Dim fd As FileDialog
    On Error Resume Next

能够得到GPS信息吗

YZC51

sxz4494 发表于 2020-1-7 12:32
能够得到GPS信息吗

老师好！这个没试过！

YZC51

谢谢 wj2368 老师的代码。谢谢老师！

Function jw(x, y) As Double     '四舍六入五成双
    Dim ij As Double
    x = x * (10 ^ y)
    x1 = Int(x)
    x2 = Format(x - x1, "0.00")
    x3 = x1 Mod 2
    If x2 > 0.5 Or (x2 = 0.5 And x3 <> 0) Then
        x1 = x1 + 1
    End If
    jw = x1 * (10 ^ (-y))
End Function