VB - разделить строки, сохраняя каждую строку с идентификатором столбца A в EXCEL

Question

Мой первый пост, когда я пытаюсь решить проблему с Excel. Если я могу сделать это с помощью формулы, я открыт для этого, но пока все, что я нашел, это решения VB.

Я пытаюсь взять идентификаторы в столбце B и сделать из них отдельные строки, пока они всеоставайтесь сопоставленными с колонкой A text. Пример 1 - это то, что мне дано, и я хотел бы посмотреть, смогу ли я сделать так, чтобы это выглядело как пример 2. У меня 500 строк, как это, и мне нужно создать отдельные строки, как в примере 2.

Пример 1

Column A    Column B
1/15/2011   11HM1N1,21HM1N1,31HM1N1,41HM1N1,51HM1N1,D0HM1N1,F0HM1N1,G0HM1N1,H0HM1N1,J0HM1N1

Это то, чего я пытаюсь достичь.

Пример 2

Column A    Column B
1/15/2011  11HM1N1
1/15/2011  21HM1N1
1/15/2011  31HM1N1
1/15/2011  41HM1N1
1/15/2011  51HM1N1
1/15/2011  D0HM1N1
1/15/2011  F0HM1N1
1/15/2011  G0HM1N1
1/15/2011  H0HM1N1
1/15/2011  J0HM1N1

Вот код, который я пытался использовать, который я нашел в SO. Он разделяет их, НО вместо того, чтобы хранить идентификаторы, которые были изначально привязаны к датам, они были отделены и получили некоторое случайное число для идентификаторов после первой запятой. Любая помощь приветствуется.

Sub test()
Dim objRegex As Object
Dim X
Dim Y
Dim lngRow As Long
Dim lngCnt As Long
Dim tempArr() As String
Dim strArr
Set objRegex = CreateObject("vbscript.regexp")
objRegex.Pattern = "^\s+(.+?)$"
 'Define the range to be analysed
X = Range([a1], Cells(Rows.Count, "b").End(xlUp)).Value2
ReDim Y(1 To 2, 1 To 1000)
For lngRow = 1 To UBound(X, 1)
     'Split each string by ","
    tempArr = Split(X(lngRow, 2), ",")
    For Each strArr In tempArr
        lngCnt = lngCnt + 1
         'Add another 1000 records to resorted array every 1000 records
        If lngCnt Mod 1000 = 0 Then ReDim Preserve Y(1 To 2, 1 To lngCnt + 1000)
        Y(1, lngCnt) = X(lngRow, 1)
        Y(2, lngCnt) = objRegex.Replace(strArr, "$1")
    Next
Next lngRow
 'Dump the re-ordered range to columns C:D
[c1].Resize(lngCnt, 2).Value2 = Application.Transpose(Y)
End Sub

Answer 1

Указанные числа были сериями дат, которые я отформатировал для ячейки в формате даты.

Answer 2

Я бы попробовал это так. Я жестко запрограммировал дату, но вы можете изменить ее на нужное значение. Я вижу, что вы используете split и resize и т. Д., Но не уверены в необходимости RegEx?

Dim a() As String

a = Split("11HM1N1,21HM1N1,31HM1N1,41HM1N1,51HM1N1,D0HM1N1,F0HM1N1,G0HM1N1,H0HM1N1,J0HM1N1", ",")
b = DateSerial(2017, 3, 5)

Range("a1").Resize(UBound(a) + 1).Value = b
Range("b1").Resize(UBound(a) + 1).Value = Application.Transpose(a)