Разбор и сравнение сложной строки

Question

Я надеюсь, что кто-нибудь может помочь мне с макросом VBA Excel.
Я получил рабочий лист в Excel 2007, который содержит названия продуктов в одном столбце, и мне нужно отсортировать его в логическом формате, чтобы я мог его использовать. Однако сам список не в каком-либо логическом порядке, его длина составляет 10 000 строк, и мне придется делать это каждый месяц !!

По сути, я хотел бы найти определенные ключевые слова, которые являются общими для большинства записей, и переместить их в отдельные ячейки в разных столбцах (но в той же строке, что и исходная запись).

Относительно ключевых слов: есть 3 различных типа, два из которых у меня есть полный список.

Пример ключевых слов: некоторые меры, такие как см (сантиметр), мм (миллиметр), м (метр) и т. Д.). Затем есть другие ключевые слова, такие как% и, наконец, последний набор ключевых слов: дерево, пластик, стекло и т. Д.

Если бы это не было достаточно сложно, меры (например, см) дублируются в некоторых случаях и являются важными деталями, поэтому я не могу просто разделить их, но в идеале хотелось бы, чтобы они были в двух соседних ячейках.

К счастью, после каждой меры, знака% и материала элемента есть пробел.

Работать справа налево - это самый простой способ достижения этой цели, поскольку первое описание в строке сильно различается между записями, и оно может оставаться как есть.

Итак, ниже пример строки, скажем, это в ячейке A1. (Кавычки не включены в строку, а слово «по» встречается только в 100 случаях. Обычно оно отсутствует ...)

"Ножка стула из дерева 100% 1м на 20см"

В идеале я хотел бы, чтобы строка была разбита на ячейки следующим образом

Cell B1 - Chair Leg  
Cell C1 - Wood  
Cell D1 - 1m  
Cell E1 - 2cm  
Cell F1 - 100%  

Было бы очень полезно иметь% показателей в одном столбце

Может ли кто-нибудь помочь мне с этим или с началами макроса, который делает это, а затем перемещается вниз по списку - я пытался использовать некоторые базовые формулы "find" и "len", но на самом деле я не знаю, как разобраться с этим!

Answer 1

Задача сводится к определению надежного определения структуры входных данных.

Форма информации при условии, что определение кандидата может быть

<Description, one or more words> <Material, one word> <A value followd by %> <Dimension A> <optional "by">  <Dimension B>

Следующий макрос будет обрабатывать данныеэто соответствует этой спецификации.Определение может нуждаться в расширении, например, двухслойные материалы (например, Mild Steel)

Вам нужно будет добавить обработку ошибок в случае, если какие-либо строки не соответствуют, например, нет% в строке или символ% в другом месте строки

Option Explicit

Dim dat As Variant

Sub ProcessData()
    Dim r As Range
    Dim i As Long

    Set r = Intersect(ActiveSheet.UsedRange, ActiveSheet.Columns(1)).Resize(, 5)
    dat = r
    For i = 1 To UBound(dat, 1)
        ParseRow i, CStr(dat(i, 1))
    Next
    r = dat
    ActiveSheet.Columns(5).Style = "Percent"

End Sub


Sub ParseRow(rw As Long, s As String)
    'Chair Leg Wood 100% 1m by 20cm

    Dim i As Long
    Dim sDim As String, sPCnt As String, sMat As String, sDesc As String
    Dim sA As String, sB As String

    i = InStr(s, "% ")
    sDim = Trim(Replace(Mid(s, i + 2), " by ", " "))  ' text to right of %, remove "by"
    sA = Trim(Left(sDim, InStr(sDim, " ")))           ' split dimension string in two
    sB = Trim(Mid(sDim, InStr(sDim, " ")))
    s = Left(s, i)

    i = InStrRev(s, " ")
    sPCnt = Mid(s, i + 1)        ' text back to first space before %
    s = Trim(Left(s, i))  

    i = InStrRev(s, " ")         ' last word in string
    sMat = Mid(s, i + 1)
    sDesc = Trim(Left(s, i))     ' whats left


    dat(rw, 1) = sDesc
    dat(rw, 2) = sMat
    dat(rw, 3) = sA
    dat(rw, 4) = sB
    dat(rw, 5) = sPCnt

End Sub

Answer 2

Вот мой удар.Мы могли бы использовать еще около 10 примеров, но это должно быть началом.Чтобы использовать, выберите один столбец диапазона с вашими описаниями и запустите SplitProduct.Он будет разбит на части справа от каждой ячейки.

Sub SplitProducts()

    Dim rCell As Range
    Dim vaSplit As Variant
    Dim i As Long
    Dim aOutput() As Variant
    Dim lCnt As Long

    Const lCOLDESC As Long = 1
    Const lCOLMAT As Long = 2
    Const lCOLPCT As Long = 3
    Const lCOLREM As Long = 4

    If TypeName(Selection) = "Range" Then
        If Selection.Columns.Count = 1 Then
            For Each rCell In Selection.Cells
                'split into words
                vaSplit = Split(rCell.Value, Space(1))
                ReDim aOutput(1 To 1, 1 To 1)

                'loop through the words
                For i = LBound(vaSplit) To UBound(vaSplit)
                    Select Case True
                        Case IsPercent(vaSplit(i))
                            'percents always go in the same column
                            lCnt = lCOLPCT
                            If UBound(aOutput, 2) < lCnt Then
                                ReDim Preserve aOutput(1 To 1, 1 To lCnt)
                            End If
                            aOutput(1, lCnt) = vaSplit(i)
                        Case IsInList(vaSplit(i))
                            'list items always go in the same column
                            lCnt = lCOLMAT
                            ReDim Preserve aOutput(1 To 1, 1 To lCnt)
                            If UBound(aOutput, 2) < lCnt Then
                                ReDim Preserve aOutput(1 To 1, 1 To lCnt)
                            End If
                            aOutput(1, lCnt) = vaSplit(i)
                        Case IsMeasure(vaSplit(i))
                            'measurements go in the last column(s)
                            If UBound(aOutput, 2) < lCOLREM Then
                                lCnt = lCOLREM
                            Else
                                lCnt = UBound(aOutput, 2) + 1
                            End If
                            ReDim Preserve aOutput(1 To 1, 1 To lCnt)
                            aOutput(1, lCnt) = vaSplit(i)
                        Case Else
                            'everything else gets concatentated in the desc column
                            aOutput(1, lCOLDESC) = aOutput(1, lCOLDESC) & " " & vaSplit(i)
                    End Select
                Next i

                'remove any extraneous spaces
                aOutput(1, lCOLDESC) = Trim(aOutput(1, lCOLDESC))

                'write the values to the left of the input range
                rCell.Offset(0, 1).Resize(1, UBound(aOutput, 2)).Value = aOutput

            Next rCell
        Else
            MsgBox "Select a one column range"
        End If
    End If

End Sub

Function IsPercent(ByVal sInput As String) As Boolean

    IsPercent = Right$(sInput, 1) = "%"

End Function

Function IsInList(ByVal sInput As String) As Boolean

    Dim vaList As Variant
    Dim vaTest As Variant

    'add list items as needed
    vaList = Array("Wood", "Glass", "Plastic")
    vaTest = Filter(vaList, sInput)

    IsInList = UBound(vaTest) > -1

End Function

Function IsMeasure(ByVal sInput As String) As Boolean

    Dim vaMeas As Variant
    Dim i As Long

    'add measurements as needed
    vaMeas = Array("mm", "cm", "m")

    For i = LBound(vaMeas) To UBound(vaMeas)
        'any number of characters that end in a number and a measurement
        If sInput Like "*#" & vaMeas(i) Then
            IsMeasure = True
            Exit For
        End If
    Next i

End Function

Нет гарантий, что это будет быстро на 10 тыс. Строк.

Answer 3

Во-первых, я бы использовал функцию Split для разделения частей в массив, это позволит избежать большинства строковых функций и математики строк:

Dim parts As Variant
parts = Split(A1)

Затем я сделаю свои сравнения скаждая часть.
Наконец, я объединяю части, которые не были выделены, и помещаю все части на лист.

Это основано на вашем примере с пробелами между каждой частью, хотя что-то похожее может работать иначе, вам просто нужно больше работать с каждой частью.