Question

我只是花了大半天时间试图弄清楚如何做到这一点，而我得到的最多的是我想要完成的一两项操作，然后我就无法完成剩下的工作了。工作。

我将在序言中说我目前有一个＆＃34;中级＆＃34;用于多步骤过程的工作表，因此必须以我想要的方式做到这一点是完全可以接受的。

现在针对那个实际问题：

我有一个非常大的列表（接近2000行）的原始数据。此列表中的每个单元格可以包含任何内容（空白），0或6位数字（243300,143356等）或同一单元格中的多个6位数字，以空格分隔。

我想做的是：

删除所有空白单元格
如果适用，单独包含多个值的单元格
删除重复值
按字母数字排序剩余值
将结果列表放在＆＃34; Main＆＃34;工作表，用于向用户提供干净的演示文稿。

解决方案无法修改原始列表中的值（这就是为什么我有＆＃34;中级＆＃34;工作表）它也需要自动完成，所以没有宏。

我目前拥有的是：

    =IFERROR(INDEX(Raw!$G$2:$G$5000, MATCH(0, COUNTIF(Intermediate!$F$2:$F2, Raw!$G$2:$G$5000), 0)),"")

它给了我一个没有空格的列表，没有重复，但没有排序，没有多值单元格分割; 或

    Public Function Blah(ParamArray args()) As String
'Declarations
Dim uniqueParts As Collection
Dim area As Range
Dim arg, arr, ele, part
Dim i As Long

'Initialisations
Set uniqueParts = New Collection

'Enumerate through the arguments passed to this function
For Each arg In args
    If TypeOf arg Is Range Then 'range so we need to enumerate its .Areas
        For Each area In arg.Areas
        arr = area.Value 'for large ranges it is greatly quicker to load the data at once rather than enumerating each cell in turn
            For Each ele In arr 'enumerate the array
                 addParts CStr(ele), uniqueParts 'Call our sub to parse the data
            Next ele
        Next area
    ElseIf VarType(arg) > vbArray Then 'an array has been passed in
        For Each ele In arg 'enumerate the array
            addParts CStr(ele), uniqueParts 'Call our sub to parse the data
        Next ele
    Else 'assume can be validly converted to a string. If it cannot then it will fail fast (as intended)
        addParts CStr(arg), uniqueParts 'Call our sub to parse the data
    End If
Next arg

'process our results
If uniqueParts.Count > 0 Then
    ReDim arr(0 To uniqueParts.Count - 1)
    For i = 1 To uniqueParts.Count
        arr(i - 1) = uniqueParts(i)
    Next i
    'we now have an array of the unique parts, which we glue together using the Join function, and then return it
    Blah = Join(arr, ",")
End If

End Function
'Sub to parse the data. In this case the sub splits the string and adds the split elements to a collection, ignoring duplicates
Private Sub addParts(partsString As String, ByRef outputC As Collection)
'ByRef is unecessary but I use it to document that outputC must be instantiated
    Dim part
    For Each part In Split(partsString, ",")
        On Error Resume Next 'existing same key will raise an error, so we skip it and just carry on
        outputC.Add part, part
        On Error GoTo 0
    Next part
End Sub

不幸的是，当谈到UDF和VBA时，我是一个菜鸟，所以我甚至无法弄清楚如何更改UDF，以便将其导出到一系列行而不是合并结果。（我知道＆＃34;加入＆＃34;最后部分，但我不知道该替换它的内容）

我知道这是一项艰巨的任务，但我们非常欢迎任何正确方向的帮助或推动。

随意询问我是否忘记提供有用的信息。

非常感谢。

Answer 1

以下是vba中的解决方案：）

Sub PerformTask()
    Dim oSel As Range
    Dim oWS As Worksheet
    Dim iCol As Integer
    Dim iMax As Integer

    iMax = 10

    'Copy original sheet
    Set oWS = ActiveWorkbook.Sheets(1)
    oWS.Copy after:=oWS

    ' get the new worksheet
    Set oWS = ActiveWorkbook.Sheets(oWS.Index + 1)

    'sort column to remove blanks
    SortColumn oWS, 1

    Set oSel = oWS.Columns(1)
    oSel.TextToColumns DataType:=xlDelimited, Space:=True 'parse data

    ' sort columns assuming not more than 10 if more change iMax
    For iCol = 2 To iMax
        SortColumn oWS, iCol 'Sort column to remove blanks
    Next

    'copy data to column 1
    For iCol = 2 To iMax
        Set oSel = oWS.Cells(1, iCol)

        ' if more than one row select all
        If oSel.Offset(1, 0).Value <> "" Then
            Set oSel = Range(oSel, oSel.End(xlDown))
        End If

        oSel.Cut

        ' Move to the last free cell on column 1
        oWS.Cells(1, 1).End(xlDown).Offset(1, 0).Select
        oWS.Paste
    Next

    SortColumn oWS, 1 'Sort

End Sub

Sub SortColumn(poWS As Worksheet, piCol As Integer)
    Dim oSel As Range

    Set oSel = poWS.Columns(piCol)
    With poWS.Sort
        .SortFields.Clear
        .SortFields.Add oSel
        .SetRange oSel
        .Apply
    End With

End Sub

如何获取值列表，执行多个＆＃34;清理＆＃34;对它们进行操作并将它们放在工作簿的其他位置？

1 个答案: