値を連結するUDF

Question

私はVBAを使用してExcelでユーザー定義関数を作成しようとしています。これは、その行にx印を持つ店舗のリストを連結します。

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

私はこのvbaコードを書くことができましたが、これが最良のアプローチであるとは確信できません。私は1000以上の行を試していたので、かなり遅かったです。それを最適化することは可能でしょうか？

firstStore最初にストアを開始する（しない名前が、×印、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. はマッチ（店番号VX）の配列を返すようにEvaluateを使用しています
2. Filter別の方法マッチ

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

の最終的な配列から文字列を作るために、非マッチ（ "V"） Join

を除去実現するのは以下の通りです。あなたは、シート

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