如何提取用过滤器分隔的 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

A3、A4、A5 等都遵循相似的格式

我需要一些方法将以下信息提取到自己的单元格中：

我需要检查每个分号分隔的值是否已经有一个列名，如果没有，创建一个新列并将所有对应的值放在需要的地方

我考虑过使用 text->columns，然后使用 index/match，但我无法使我的匹配条件正常工作。打算为每个独特的列执行此操作。或者我需要使用 VBA?

Answer 1

您可以使用类似的方法，但您必须更新 sheet 名称以及您希望最终数据所在的位置。

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

Answer 2

我的以下解决方案按预期工作，但数据的格式与我原先想象的不同。

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

如何提取用过滤器分隔的 excel 单元格值？

How to extract excel cell values delimited with filters?

excel

vba

excel-2007

excel-formula