UDF来连接值

我正在尝试使用VBA for excel来构build用户定义的函数。 这将连接在该行中具有斧痕的商店列表。

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

我设法写这个VBA代码,但我不知道这是最好的办法。 当我在1000多行上进行testing时,速度很慢。 也许有可能优化它?

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 

简短但错综复杂。

  1. 使用Evaluate返回匹配数组(Store numbers vx)
  2. Filter删除不匹配(“V”)
  3. Join以从最终的匹配数组中获得string

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 

在这里输入图像说明

另一种实现方式如下。 你可以做任何地方在床单

 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 

在这里输入图像说明