UDF连接值

Question

我正在尝试使用VBA for excel构建用户定义的函数。这将连接在该行中具有x标记的商店列表。

   Store1 Store2 Store3    Concatenate
      x             x      Store1,Store3  
      x      x             tore1,Store2
      x                    Store1

我设法写了这个vba代码，但我不确定这是最好的方法。当我在1000多线上进行测试时，它非常缓慢。也许有可能优化它？

firstStore 指出第一家商店的起点（不是名称，而是x标记， lastStore1 最后一列。 listofstores1 是商店名称所在的行。

Function listofstores(firstStore As Range, lastStore1 As Range, listofstores1 As Range)
    Application.Volatile

    Dim offsetvalue As Integer

    offsetvalue = -(lastStore1.Row - listofstores1.Row)

    lastStore = lastStore1.Column
    Set initial = firstStore

    For i = 1 To lastStore
    If initial = "X" Or initial = "x" Then Store = initial.Offset(offsetvalue, 0)
    c = 1
    Set initial = initial.Offset(0, c)
    listofstores = listofstores & " " & Store
    Store = ""


    Next i
    End Function

Answer 1

简短但错综复杂。

1. 使用Evaluate返回匹配数组（存储数字v x）
2. Filter删除不匹配（＆＃34; V＆＃34;）
3. Join从最终的匹配数组中生成字符串

UDF

Function Getx(Rng1 As Range, Rng2 As Range) As String
Getx = Join(Filter(Evaluate("=ÏF(" & Rng2.Address & "=""x""," & Rng1.Address & ",""V"")"), "V", False), ",")
End Function

Answer 2

另一种实现方式如下。您可以在工作表中进行任何操作

Sub Main()
    Call getlistofstores(Range("G13:L15"), Range("G12:L12"))
End Sub

Function getlistofstores(stores As Range, listofstores As Range)
    Application.Volatile
    Dim fullconcatstring As String
    Dim row As Integer
    Dim column As Integer
    a = stores.Count / listofstores.Count
    b = listofstores.Count
    row = stores.Cells(1).row
    column = stores.Cells(1).column + (b)
    For i = 1 To a
        For j = 1 To b
            If stores.Cells(i, j) = "x" Then
                If concatstring <> "" Then
                    concatstring = concatstring & ", " & listofstores.Cells(j)
                Else
                    concatstring = listofstores.Cells(j)
                End If
            End If
        Next j
        fullconcatstring = fullconcatstring & Chr(10) & Chr(11) & concatstring
        concatstring = ""
    Next i
    Call concatenateallstores(row, column, fullconcatstring)
End Function

Sub concatenateallstores(r As Integer, c As Integer, d As String)
    str1 = Split(d, Chr(10) & Chr(11))
    str2 = UBound(str1)
    For i = 1 To str2
        Cells(r, c) = str1(i)
        r = r + 1
    Next i
End Sub