Question

我为特定的订单号（C2：C100）生成了零件号（A2：A100）及其数量（B2：B100）的列表。我正在编写一个子程序，该子程序将过滤每个唯一零件号的零件号列表，然后创建一个新列表，其中包含每个零件的总数以及将使用该零件的每个订单。

我有一个成功创建唯一零件号列表（F8：F100）的子程序，然后另一个子程序自动过滤了每个唯一零件号的零件号主列表（A2：A100）并为该特定零件的订货号（C2：C100）。我试图连接订单号的范围，但是我的功能失败了。

Sub WOSorter()
    Dim rng As Range
    Dim WOrng As Range
    Dim i As Long
    Dim Limit As Long
    Dim seperator As String

    seperator = ", "

    Limit = Worksheets("Selector").Range("F8:F100").Cells.SpecialCells(xlCellTypeConstants).Count - 1

    For i = 0 To Limit
    Set rng = Worksheets("Selector").Cells(8 + i, 6)
        With Worksheets("Selector").Range("A1")
        .AutoFilter Field:=1, Criteria1:=rng
            Set WOrng = Worksheets("Selector").Range("C2:C100").Cells.SpecialCells(xlCellTypeVisible)
            Worksheets("Selector").Cells(8 + i, 9).Value = ConcatenateRange(WOrng, seperator)
        End With
    Next

    If Worksheets("Selector").AutoFilterMode Then Worksheets("Selector").AutoFilter.ShowAllData

End Sub

-----------------------------------------------------------------------------

Function ConcatenateRange(ByVal WOrng As Range, Optional ByVal seperator As String) As String

Dim newString As String
Dim cellArray As Variant
Dim i As Long, j As Long

cellArray = WOrng.Value

For i = 1 To UBound(cellArray, 1)
    For j = 1 To UBound(cellArray, 2)
        If Len(cellArray(i, j)) <> 0 Then
            newString = newString & (seperator & cellArray(i, j))
        End If
    Next
Next

If Len(newString) <> 0 Then
    newString = Right$(newString, (Len(newString) - Len(seperator)))
End If

ConcatenateRange = newString

End Function

我当前在行上遇到类型不匹配错误：

For i = 1 To UBound(cellArray, 1)

如果原始列表在colA，B，C中，并且在colF中具有唯一的部件号：

colA      colB     colC               colF
123-4     1        01111              123-4
456-7     2        02222              456-7
123-4     1        03333              789-0 
789-0     1        04444
456-7     3        05555

那么结果应该是：

colA      colB     colC               colF         colI
123-4     1        01111              123-4        01111, 03333
456-7     2        02222              456-7        02222, 05555 
123-4     1        03333              789-0        04444
789-0     1        04444
456-7     3        05555

Answer 1

使用链接上的函数将代码更改为：

Sub WOSorter()

    Dim seperator As String
    seperator = ", "

    With Worksheets("Selector")
        Dim lstrow As Long
        lstrow = .Cells(.Rows.Count, "F").End(xlUp).Row


        Dim i As Long
        For i = 2 To lstrow
            .Range("I" & i).Value = TEXTJOINIFS(.Range("C:C"), seperator, .Range("A:A"), .Range("F" & i).Value)
        Next i

     End With


End Sub

这不依赖于筛选器，后者不允许大量加载数组。

这是textjoinifs函数：

Function TEXTJOINIFS(rng As Range, delim As String, ParamArray arr() As Variant) As String
    Dim rngarr As Variant
    rngarr = Intersect(rng, rng.Parent.UsedRange).Value

    Dim condArr() As Boolean
    ReDim condArr(1 To Intersect(rng, rng.Parent.UsedRange).Rows.Count) As Boolean

    TEXTJOINIFS = ""

    Dim i As Long
    For i = LBound(arr) To UBound(arr) Step 2
        Dim colArr() As Variant
        colArr = Intersect(arr(i), arr(i).Parent.UsedRange).Value
        Dim j As Long
        For j = LBound(colArr, 1) To UBound(colArr, 1)

            If Not condArr(j) Then
                Dim charind As Long
                charind = Application.Max(InStr(arr(i + 1), ">"), InStr(arr(i + 1), "<"), InStr(arr(i + 1), "="))
                Dim opprnd As String
                If charind = 0 Then
                    opprnd = "="
                Else
                    opprnd = Left(arr(i + 1), charind)
                End If
                Dim t As String
                t = """" & colArr(j, 1) & """" & opprnd & """" & Mid(arr(i + 1), charind + 1) & """"
                If Not Application.Evaluate(t) Then condArr(j) = True
            End If
        Next j
    Next i

    For i = LBound(rngarr, 1) To UBound(rngarr, 1)
        If Not condArr(i) Then
            TEXTJOINIFS = TEXTJOINIFS & rngarr(i, 1) & delim
        End If
    Next i
    If TEXTJOINIFS <> "" Then
        TEXTJOINIFS = Left(TEXTJOINIFS, Len(TEXTJOINIFS) - Len(delim))
    End If

End Function

这里是输出：

如何使用VBA对列范围进行排序和连接

1 个答案: