从带有文本 SQL/Excel/VBA 的单个字段中提取多个日期

Question

I currently have a spreadsheet with a free text column, within each entry there are multiple dates that sit in the format 13.1.11 or 1.11.12 (dd.mm.yy). What i would like to do is extract all the dates from each entry, below I have listed a sample of the data and also the desired output. Are there any solutions to get the desired output in Excel,VBA or SQL?

Example of current Data

• 6.5.18 - no int in zone 1 but int in zone 2. 18.7.19 - summer update.
• 12.7.19 - may have French investor. 11.9.19 - invests in series c firms
• 4.5.17 - James interested in purchase. 14.3.18 - only invest in passed ventures. 20.11.18 - sent material. 24.7.19 - summer update.
• Zone IV 5.9.19 - not available

Desired Ouput

• 6.5.18; 18.7.19
• 12.7.19; 11.9.19
• 4.5.17; 14.3.18; 20.11.18; 24.7.19
• 5.9.19

Many Thanks

Answer 1

If it's a one time thing, then I would suggest doing this in excel. You could use "Text to Column" under the "Data" tab, with "-" as the delimiter to extract all of these individual cases. Then you can use the left/right/mid functions, to extract just the date values. If it's going to be a regular thing, then you can look into more automated processes using VBA or SQL. Hope this helps.

Answer 2

If the text is in column A this will put the dates in column B.

Option Explicit
Sub ExtractDates()

    Dim ws As Worksheet, sPattern As String
    Set ws = ThisWorkbook.Sheets(1)

    Dim Regex As Object
    Set Regex = CreateObject("vbscript.regexp")

    sPattern = "(\d{1,2}\.\d{1,2}\.\d\d)"
    With Regex
      .Global = True
      .MultiLine = False
      .IgnoreCase = True
      .Pattern = sPattern
    End With

    Dim cell, sOut As String, iLastRow As Long
    Dim match, dt

    iLastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    For Each cell In ws.Range("A1:A" & iLastRow)
        sOut = ""
        If Regex.test(cell) Then
            Set match = Regex.Execute(cell)
            For Each dt In match
                If Len(sOut) > 0 Then sOut = sOut & "; "
                sOut = sOut & dt
            Next
            cell.Offset(0, 1) = sOut
        End If
    Next

End Sub