VBA在一个单元格中分隔多个日期

Question

I am trying to separate multiple dates from one cell into multiple cells containing one date in a transposed area and then paste them back over the original area as separate entries.

An example cell might have dates stored like 10/1110/1110/13 or 10/310/310/410/5. The second scenario is what is causing the error as there is no leading zero for single digit days like 10/3, for example.

Ideally, the code would separate the dates into separate cells like: 10/11,10/11,10/13 and 10/3,10/4,10/5. When single digits days are present ,however, it comes out completely jumbled up and inaccurate.

Admittedly, I had help from another coworker with this code who is on vacation currently, which is why I am having such trouble understanding this. Is there something I could change to account for single digit days or should I approach this process differently?

Thanks!

'separate column J by "/" and store in transpose area

  dim h as variant
  dim i as variant
  dim j as variant
  dim counter as variant
  dim stringcheck as variant
  dim strInput as variant
  dim strCurrent as variant



 strInput = Cells(j, 10)
 h = 0

For counter = 1 To Len(strInput) - 2
    stringcheck = InStr(strInput, "/")
    Debug.Print j & stringcheck
    If stringcheck <> 0 Then


        If Mid(strInput, counter, 1) = "/" Then
            Cells(17, i + h) = strCurrent & Mid(strInput, counter, 3)
            counter = counter + 2
            h = h + 1
            strCurrent = vbNullString
        Else
            Cells(17, i + h) = Cells(j, 10)
            strCurrent = strCurrent & Mid(strInput, counter, 1)

        End If

    'else just paste the value
    Else
        Cells(17, i) = strInput
    End If

Next counter

Answer 1

If all of the months within one cell's mashed up dates can be reasonably assumed to be the same then that could be used as a delimiter to split the mash-up and reassemble it.

Function splitMashUp(str As String, _
                     Optional splitchr As String = "/", _
                     Optional delim As String = ", ")
    Dim i As Long, tmp As Variant

    tmp = Split(str, Left(str, InStr(1, str, splitchr)))
    For i = LBound(tmp) + 1 To UBound(tmp)
        tmp(i) = Left(str, InStr(1, str, splitchr)) & tmp(i)
    Next i
    splitMashUp = Mid(Join(tmp, delim), Len(delim) + 1)
End Function