Я не знал, как объяснить вопрос, поэтому я приложу изображения для объяснения моей ситуации.Вот вид моего листа Excel:
Мой лист Excel
Подсвеченные ячейки содержат несколько значений, называемых ID , и связаны с нимис соответствующими версиями в столбцах рядом с ними.Я использую следующий макрос (подробности с подробным объяснением здесь) , чтобы разбить эти значения на несколько строк на одном листе.
Option Explicit
Private Const ID_IDX As Long = 0
Private Const VER_IDX As Long = 1
Private Const RNG_IDX As Long = 2
Private Sub RunMe()
Dim data As Variant, cols As Variant, items As Variant
Dim r As Long, c As Long, i As Long, n As Long
Dim ids() As String, vers() As String
Dim addItems As Collection, concatItems As Collection
Dim dataRng As Range, rng As Range
Dim writeID() As Variant, writeVer() As Variant, writeConcat() As Variant
Dim dataStartRow As Long
On Error Resume Next
'Define the range we're interested in and read into an array.
With Sheet1 'adjust for your worksheet object
Set dataRng = Application.InputBox(prompt:="Select the Range of cells:", Type:=8)
End With
data = dataRng.Value2
dataStartRow = 2
'Find the two target columns
cols = AcquireIdAndVerCol(data, 3, 8)
If IsEmpty(cols) Then
MsgBox "Unable to find Id and Ver columns."
Exit Sub
End If
With dataRng
'Add a column next to the version number column.
.Columns(cols(VER_IDX)).Offset(, 1).Insert Shift:=xlShiftToRight, CopyOrigin:=xlFormatFromLeftOrAbove
'Add a column to our range.
'This is to cover the case that the rightmost column is the version number column.
Set dataRng = .Resize(, .Columns.Count + 1)
End With
'Find the rows that need to be split and concatenate the target strings.
Set addItems = New Collection
Set concatItems = New Collection
For r = dataStartRow To UBound(data, 1)
ids = Split(data(r, cols(ID_IDX)), vbLf)
vers = Split(data(r, cols(VER_IDX)), vbLf)
n = IIf(UBound(ids) >= UBound(vers), UBound(ids), UBound(vers))
If n = 0 Then 'it's just one line of text.
'Add concatenated text to list.
concatItems.Add data(r, cols(ID_IDX)) & " " & data(r, cols(VER_IDX))
ElseIf n > 0 Then 'it's multiple lines of text.
'Transpose the id array.
ReDim writeID(1 To UBound(ids) + 1, 1 To 1)
For i = 0 To UBound(ids)
writeID(i + 1, 1) = ids(i)
Next
'Transpose the version array.
ReDim writeVer(1 To UBound(vers) + 1, 1 To 1)
For i = 0 To UBound(ids)
writeVer(i + 1, 1) = vers(i)
Next
'Add concatenated text to list.
For i = 0 To n
concatItems.Add (IIf(UBound(ids) <= n And UBound(vers) <= n, ids(i) & " " & vers(i), Empty))
Next
'Add the range to be split to the collection.
addItems.Add Array(writeID, writeVer, dataRng.Rows(r + 1).Resize(n))
Else 'it's an empty cell
'Add empty item to concatenated list in order to keep alignment.
concatItems.Add Empty
End If
Next
Application.ScreenUpdating = False
'Split the ranges in the list.
If addItems.Count > 0 Then
For Each items In addItems
'Add the rows.
With items(RNG_IDX)
.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Set rng = .Offset(-.Rows.Count - 1).Resize(.Rows.Count + 1)
'Note: format your rng Range obect as desired here.
End With
'Write the id and version values.
rng.Columns(cols(ID_IDX)).Value = items(ID_IDX)
rng.Columns(cols(VER_IDX)).Value = items(VER_IDX)
Next
End If
'Write the concatenated values.
If concatItems.Count > 0 Then
ReDim writeConcat(1 To concatItems.Count + dataStartRow - 1, 1 To 1)
'Header to array.
writeConcat(1, 1) = "Concat values"
'Values from the collection to array.
i = dataStartRow
For Each items In concatItems
writeConcat(i, 1) = items
i = i + 1
Next
'Output array to range.
With dataRng.Columns(cols(VER_IDX) + 1)
.Value = writeConcat
.AutoFit
End With
End If
Application.ScreenUpdating = True
End Sub
Private Function AcquireIdAndVerCol(data As Variant, minCol As Long, maxCol As Long) As Variant
Dim result(1) As Long
Dim r As Long, c As Long, i As Long
Dim items() As String
'Check we're not operating outside bounds of data array.
If minCol < LBound(data, 2) Then minCol = LBound(data, 2)
If minCol > UBound(data, 2) Then minCol = UBound(data, 2)
If maxCol < LBound(data, 2) Then maxCol = LBound(data, 2)
If maxCol > UBound(data, 2) Then maxCol = UBound(data, 2)
'Loop through data to find the two columns.
'Once found, leave the function.
For r = 1 To UBound(data, 1)
For c = minCol To maxCol
items = Split(data(r, c), vbLf)
For i = 0 To UBound(items)
If result(ID_IDX) = 0 Then
If IsDocId(items(i)) Then
result(ID_IDX) = c
If result(VER_IDX) = 0 Then
Exit For
Else
AcquireIdAndVerCol = result
Exit Function
End If
End If
End If
If result(VER_IDX) = 0 Then
If IsDocVer(items(i)) Then
result(VER_IDX) = c
If result(ID_IDX) = 0 Then
Exit For
Else
AcquireIdAndVerCol = result
Exit Function
End If
End If
End If
Next
Next
Next
End Function
Private Function IsDocId(val As String) As Boolean
Dim n As Long
n = TryClng(val)
IsDocId = (n > 9999 And n <= 999999999)
End Function
Private Function IsDocVer(val As String) As Boolean
Dim n As Long, m As Long
Dim items() As String
items = Split(val, ".")
If UBound(items) <> 1 Then Exit Function
n = TryClng(items(0))
m = TryClng(items(1))
IsDocVer = (n > 0 And n <= 99) And (m >= 0 And m <= 9)
End Function
'-------------------------------------------------------------------
'Converts a variant to a Long or returns a fail value as a Long
'if the conversion failed.
'-------------------------------------------------------------------
Private Function TryClng(expr As Variant, Optional fail As Long = -1) As Long
Dim n As Long
n = fail
On Error Resume Next
n = CLng(expr)
On Error GoTo 0
TryClng = n
End Function
Это дает следующий вывод с добавленным столбцом с именем, Concat Values , который содержит объединенные значения Id's и соответствующие Версии :
Вывод
Проблема:
Работает без сбоев, если все идентификаторы имеют соответствующие версии, указанные влист отдельно, как я уже говорил выше.Однако в тех случаях, когда существует только один номер версии и он связан с 4 или более идентификаторами, т. Е. Один и тот же номер версии применим ко всем идентификаторам, например:
Вывод в столбце Значения Concat становится дезориентированным, потому что мы используем массив для вывода значений Concat, а массив не вмещает отсутствующие версии для соответствующих идентификаторов.Выглядит это так:
Смещенные значения строк
Я пытаюсь узнать и найти способ обновить коллекцию и массив новыми значениями Concatперед выводом его в столбец, чтобы каждое значение Concat помещалось в соответствующий идентификатор и местоположение версии.Я надеюсь, что это имеет смысл.Пожалуйста, дайте мне знать для получения дополнительной информации.
РЕДАКТИРОВАТЬ: Я постараюсь перечислить все возможные случаи и ожидаемый результат, включая сценарии наихудшего случая:
Вот ссылка на мой лист Excel.
Обычные сценарии
Количество идентификаторов = Количество версий (Отлично работает, значения Concat выровнены в соответствующих строках в столбцах) 
Несколько идентификаторов - одна версия (В таких случаяхВерсия №, применимая ко всем идентификаторам, одинаковая , т. е. одна Версия должна применяться ко всем идентификаторам.)
Проблема: Макрос выполняет задачу разделения столбцов на строки, за исключением части, в которой значения Concat смещены. 
Сценарии наихудшего случая
Несколько идентификаторов - несколько версий, но меньше, чем общее количество идентификаторов # 1099 * (В таких случаях версии должны соответствовать самым верхним идентификаторам и заполнять идентификаторы ниже пробелами ) Проблема: Макрос выполняет задачу разбиения столбцов на строки, за исключением части, в которой значения Concat смещены. 
Здесь 4 идентификаторам присвоены только 3 версии, поэтому 3 верхним идентификаторам назначены 3 версии, а для 4-го идентификатора нет версии, связанной с ним. Аналогично, 
Здесь 4 идентификаторам присвоены только 2 версии, поэтому 2 верхним идентификаторам назначены 2 версии, а для 3-го и 4-го идентификаторов нет версии, связанной с ними. Несколько идентификаторов - без версии (В таких случаях столбцы должны разбиваться на строки на основе # ID, а соответствующие строки версии должны заполняться пробелами ) Проблема: Макрос выполняет задачу разделения столбцов на строки, за исключением части, в которой Конкатные значения смещены. 