Поиск ваших столбцов
Regex решения чрезвычайно полезны, когда вы ищете сложные комбинации строк, но в VBA они могут быть немного медленными.Учитывая простоту шаблонов сопоставления, возможно, будет проще и быстрее использовать более «примитивные» сравнения строк.Скажем, например, ваш идентификатор документа находится между 10000 и 1000000000, вы можете просто попытаться преобразовать вашу строку в Long и посмотреть, находится ли значение между этими числами.Аналогичный подход может быть использован для сравнения каждой стороны десятичной дроби для сравнения версии документа.
При любом сравнении строк, Regex или иным, вам нужно защищаться от ложных совпадений.Например, значение ячейки «A3» соответствует шаблону версии документа.Поэтому вам нужно ввести некоторые меры предосторожности, чтобы ваш код не выбрал неправильный столбец;только вы будете знать, что это может быть надежно, но это может быть что-то столь же простое, как сказать, что версия документа может появиться только в столбце «C» или после.
Объединение значений
В вашей таблице все ячейки отформатированы как Text.Это означает, что четные числа будут интерпретироваться как строки - отсюда и маленький зеленый треугольник, предупреждающий вас об этом в ваших ячейках идентификатора и версии.Если бы они были числами, вам бы пришлось применить числовой формат к этим ячейкам (например, #0.# для версии).Для вашей электронной таблицы объединение не сложнее, чем объединение двух строк, как в str = str1 & " " & str2.
На втором изображении выглядит так, как будто у вас есть формат ячейки General (или, возможно, какое-то числоформат), поэтому эти значения интерпретируются как числа.Они должны быть отформатированы перед объединением с использованием функции NumberFormat().
Разделение строк
Разделение ячеек на строки, хотя синтаксически легко, может быть сложным, еслиВы пытаетесь отслеживать, какой ряд вы расследуете.Я делаю это для сохранения соответствующих строк в Collection, и я продолжаю ссылаться на эти объекты коллекции по мере необходимости.Преимущество этого заключается в том, что ссылка Range в Collection обновляется при добавлении строк.
В общем, ваш код относительно прост, и приведен пример его работы.ниже.Вы заметите, что я не удосужился отформатировать новые строки и столбцы - это довольно тривиально и это то, что вы можете сделать сами, чтобы удовлетворить свои собственные потребности.Этот код должен быть помещен в модуль:
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
'Define the range we're interested in and read into an array.
With Sheet1 'adjust for your worksheet object
Set dataRng = .Range(.Cells(1, "A"), .Cells(.Rows.Count, "A").End(xlUp)) _
.Resize(, .Cells(1, .Columns.Count).End(xlToLeft).Column)
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