VBA将异常字符串转换为日期

Question

我想从 yahoo 中抓取数据作为练习，然后从中制作图表。我遇到了一个问题，当我抓取日期时，它们的格式很奇怪：

?10? ?Aug?, ?2020

字符串中的问号并不是真正的问号，它们是一些我不知道的字符，所以我无法使用 Replace() 删除它们。

然后，当我尝试使用 CDate() 将其转换为日期格式时，代码因“类型不匹配”错误而崩溃。

我需要找到一种方法来找出这些字符是什么以便使用 Replace() 删除它们，或者以某种方式将这种奇怪的格式转换为日期。 或者，以某种方式改进抓取过程 - 到目前为止，我一直在使用例如

ie.document.getElementsByClassName("Py(10px) Ta(start) Pend(10px)")(3).innerText

获取数据 - 也可以解决这个问题。

如果有人想尝试抓取它，也可以提供示例网址：

https://finance.yahoo.com/quote/LAC/history?period1=1469404800&period2=1627171200&interval=1d&filter=history&frequency=1d&includeAdjustedClose=true

我的代码示例如下：

DateString = doc.getElementsByClassName("Py(10px) Ta(start) Pend(10px)")(j).innerText
LeftDateString = Clean_NonPrintableCharacters(DateString)
Worksheets("Stock_data").Range("A2").Value = CDate(LeftDateString)

Answer 1

使用正则表达式：

Function GetDate(txt)
    ' set a reference to 'Microsoft VBScript Regular Expression 5.5' in Tools->References VBE menu
    Dim re As New RegExp, retval(0 To 2), patterns, i, result
    patterns = Array("\b\d\d\b", "\b[a-zA-Z]+\b", "\b\d{4}\b")
    For i = 0 To 2
        re.Pattern = patterns(i)
        Set result = re.Execute(txt)
        If result Is Nothing Then Exit Function 'If no day, month or year is found, GetDate() returns ""
        retval(i) = result(0)
    Next
    
    GetDate = Join(retval)
End Function

Sub Usage()
    For Each txt In Array("?10? ?Aug?, ?2020", "Jul 13, 2020", "2021, March?, 18?")
        Debug.Print GetDate(txt)
    Next
End Sub

打印：

10 Aug 2020
13 Jul 2020
18 March 2021

编辑 2

Function GetDate2(txt)
    ' set a reference to 'Microsoft VBScript Regular Expression 5.5' in Tools->References VBE menu
    Static re As RegExp, months As Collection
    Dim result
    
    If re Is Nothing Then   'do it once
        Set re = New RegExp
        re.Pattern = "[^a-zA-Z0-9]"
        re.Global = True
        Set months = New Collection
        cnt = 1
        For Each m In Split("jan,feb,mar,apr,may,jun,jul,aug,sep,oct,nov,dec", ",")
            months.Add cnt, m
            cnt = cnt + 1
        Next
    End If
    
    result = Split(WorksheetFunction.Trim(re.Replace(txt, " ")))
    For i = 0 To UBound(result)
        If Not IsNumeric(result(i)) Then
            result(i) = Left(LCase(result(i)), 3)
            On Error Resume Next
            result(i) = months(result(i))
            On Error GoTo 0
        End If
    Next
    result = Join(result)
    If IsDate(result) Then GetDate2 = CDate(result)
End Function

Sub Usage2()
    For Each txt In Array("?10? ?Aug?, ?2020", "Jul 13, 2020", "2021, March?, 18?", _
                          "01/12/2021", "04.18.2020", "15 10 20")
        Debug.Print GetDate2(txt)
    Next
End Sub

打印：

10.08.2020 
13.07.2020 
18.03.2021 
01.12.2021 
18.04.2020 
15.10.2020 

注意。 dd 和 mm 的顺序可能不同

Answer 2

我会使用类似的东西。我用过你的？作为这个例子的问号，我假设它们都是同一个奇怪的字符。这输出

10 Aug 2020

Sub d()

Dim d As String

d = "?10? ?Aug?, ?2020"
d = Replace(Replace(d, Chr(Asc(Left(d, 1))), vbNullString), ",", vbNullString)

Debug.Print d

End Sub

Answer 3

您可以遍历字符串中的每个字符并检查其 ascii 值并从中创建日期字符串。示例

Sub GetTheDate(sDate As String)
'97 - 122: lower case Ascii values
Dim i As Integer
Dim strDate As String

'loop through each char
For i = 1 To Len(sDate)
    'check to see if it is numeric
    If IsNumeric(Mid(sDate, i, 1)) Then
        'numeric so add it to the string
        strDate = strDate & Mid(sDate, i, 1)
    Else
        'check to see if it is a char a-z
        If Asc(LCase(Mid(sDate, i, 1))) >= 97 And Asc(LCase(Mid(sDate, i, 1))) <= 122 Then
            'it is an a char from a-z so add it to string
            strDate = strDate & Mid(sDate, i, 1)
        Else
            'chekc for a space and add a comma - this sets up being able to use cdate()
            If Mid(sDate, i, 1) = " " Then
                strDate = strDate & ","
            End If
        End If
    End If
Next i
'convert it and print it
Debug.Print CDate(strDate)
End Sub