UDF değerleri birleştirmek için

Question

Excel için VBA kullanarak kullanıcı tanımlı bir işlev oluşturmaya çalışıyorum. Bu, o satırda x işareti olan bir mağazalar listesini birleştirir.

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

Bu vba kodunu yazmayı başardım, ancak bunun en iyi yaklaşım olduğundan emin değilim. 1000 ve daha fazla hat üzerinde deneme yaparken oldukça yavaştı. Belki optimize etmek mümkün mü?

firstStore sen yönlendireceği yeri ilk mağaza başlar (adları değil, ama x işaretleri lastStore1 son sütunu. listofstores1 mağaza isimleri nerede sırasıdır.

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

Kısa ama karmaşık.

1. maçları dizisi (Mağaza numaraları vx)
dönmek için Evaluate kullanır
2. Filter
3. Join eşleşir

nihai diziden 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

başka bir yolu dize yapmak için ("V") olmayan sonuç kaldırır elde etmek için aşağıdaki gibidir. Sen yaprak

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