Как извлечь значения ячейки excel, разделенные фильтрами?

Question

В каждой ячейке в столбце у меня эта информация в клетках:

A1 значение:

Depth=standard;Size=1 section;Doors=hinged solid;Interior configuration=shelves;Compressor HP=1/2 HP;Interior finish=stainless steel;Exterior finish=stainless steel;Refrigeration=top mount self-contained

значение A2:

Top openings= 6 pan;Size=1 section;Compressor HP=1/6 HP;Style=drawers;Exterior finish=stainless steel;Interior finish=stainless steel;Refrigeration=rear mounted

А3, А4, А5 и т. д. все следуют аналогичным форматам

Мне нужен какой-то метод ab stracting следующей информации в свои собственные клетки:

мне нужно каждый точкой с запятой значения для проверки, если есть имя столбца для него уже, если нет, то новый столбец и поместить все соответствующие значения где они должны быть

Я думал об использовании текстовых столбцов, а затем использовал индекс/совпадение, но я не смог правильно настроить критерии соответствия. Собирался сделать это для каждой уникальной колонки. Или мне нужно использовать VBA?

Answer 1

Мое решение ниже работает по назначению, но данные не были такими отформатированными, как я изначально думал.

Option Explicit 

Private Sub Auto_Open() 

MsgBox ("Welcome to the delimiter file set.") 


End Sub 

'What this program does: 
'http://i.imgur.com/7MVuZLt.png 

Sub DelimitFilter() 

Dim curSpec As String 
Dim curSpecArray() As String 
Dim i As Integer, IntColCounter As Integer, iCounter As Integer, argCounter As Integer 
Dim WrdString0 As String, WrdString1 As String 
Dim dblColNo As Double, dblRowNo As Double 

Worksheets(1).Activate 

'Reference to cell values that always have data associated to them 
Range("W2").Activate 

'checks for number of arguments to iterate through later 
Do 

    If ActiveCell.Value = "" Then Exit Do 
    ActiveCell.Offset(1, 0).Activate 
    argCounter = argCounter + 1 

Loop 

'Check # of arguments 
Debug.Print (argCounter) 

'Values to delimit 
Range("X2").Activate 
IntColCounter = 1 

'Loop each row argument 
For iCounter = 0 To argCounter 

    'Set var to activecell name 
    dblColNo = ActiveCell.Column 
    dblRowNo = ActiveCell.Row 

    'Grab input at active cell 
    curSpecArray() = Split(ActiveCell.Value, ";") 

    'Ignore empty rows 
    If Not IsEmpty(curSpecArray) Then 

     'Iterate every delimited active cell value at that row 
     For i = LBound(curSpecArray) To UBound(curSpecArray) 

      'Checks for unique attribute name, if none exists, make one 
      WrdString0 = Split(curSpecArray(i), "=")(0) 

      'a large range X1:ZZ1 is used as there are many unique column names 
      If IsError(Application.Match(WrdString0, Range("X1:ZZ1"), 0)) Then 'if NOT checks if value exists 
       Cells(1, dblColNo + IntColCounter).Value = WrdString0 
       IntColCounter = IntColCounter + 1 
      End If 

      'Output attribute value to matching row and column 
      WrdString1 = Trim(Split(curSpecArray(i), "=")(1)) 
      Debug.Print (WrdString1) 
      Cells(dblRowNo, -1 + dblColNo + Application.Match(WrdString0, Range("X1:ZZ1"), 0)).Value = WrdString1 


     Next i 

    End If 

    'Iterate Next row value 
    ActiveCell.Offset(1, 0).Activate 

Next iCounter 

End Sub 

Answer 2

Вы можете пойти с чем-то подобным, хотя вам придется обновлять имя листа и, вероятно, где вы хотите, чтобы конечные данные находились.

Sub SplitCell() 
    Dim DataFromCell, FoundCell 
    Dim Testing, Counted, LastCol 
    For Each c In Range(Range("A1"), Range("A" & Rows.count).End(xlUp)) 
     Testing = Split(c.Value, ";") 
     Range("B" & c.row + 1).Value = "A" & c.row 
     Counted = UBound(Testing) 
     For Each x In Testing 
      DataFromCell = Split(x, "=") 
      With Sheet2 
       Set FoundCell = .Cells.Find(What:=DataFromCell(0), after:=.Cells(1, 2), _ 
        LookIn:=xlValues, lookat:=1, searchorder:=xlByColumns, searchdirection:=xlNext, _ 
        MatchCase:=False, searchformat:=False) 
      End With 
      If Not FoundCell Is Nothing Then 
       Cells(c.row + 1, FoundCell.Column).Value = DataFromCell(1) 
      End If 
      If FoundCell Is Nothing Then 
       LastCol = Sheet2.Cells(1, Sheet2.Columns.count).End(xlToLeft).Column 
       Cells(1, LastCol + 1).Value = DataFromCell(0) 
       Cells(c.row + 1, LastCol + 1).Value = DataFromCell(1) 
      End If 
     Next x 
    Next c 
End Sub 

Редактировать

Поскольку выше, давая вам ошибки, вы можете попробовать это:

Sub SplitCell() 
    Dim DataFromCell, FoundCell 
    Dim Testing, Counted, LastCol 
    For Each c In Range(Range("A1"), Range("A" & Rows.count).End(xlUp)) 
     Testing = Split(c.Value, ";") 
     Range("B" & c.row + 1).Value = "A" & c.row 
     Counted = UBound(Testing) 
     For Each x In Testing 
      DataFromCell = Split(x, "=") 
      LastCol = Sheet2.Cells(1, Sheet2.Columns.count).End(xlToLeft).Column 
      With Sheet2 
       FoundCell = Application.Match(DataFromCell(0), Range(Cells(1, 2), Cells(1, LastCol)), 0) 
       'Set FoundCell = .Cells.Find(What:=DataFromCell(0), after:=.Cells(1, 2), _ 
        LookIn:=xlValues, lookat:=1, searchorder:=xlByColumns, searchdirection:=xlNext, _ 
        MatchCase:=False, searchformat:=False) 
      End With 
      If Not IsError(FoundCell) Then 
       Cells(c.row + 1, FoundCell + 1).Value = DataFromCell(1) 
      End If 
      If IsError(FoundCell) Then 

       Cells(1, LastCol + 1).Value = DataFromCell(0) 
       Cells(c.row + 1, LastCol + 1).Value = DataFromCell(1) 
      End If 
     Next x 
    Next c 
End Sub 

только изменил несколько вещей, так что он использует Match вместо Find