![複数のセル内のカンマで区切られた一意の名前をカウントするにはどうすればいいですか](https://rvso.com/image/1542503/%E8%A4%87%E6%95%B0%E3%81%AE%E3%82%BB%E3%83%AB%E5%86%85%E3%81%AE%E3%82%AB%E3%83%B3%E3%83%9E%E3%81%A7%E5%8C%BA%E5%88%87%E3%82%89%E3%82%8C%E3%81%9F%E4%B8%80%E6%84%8F%E3%81%AE%E5%90%8D%E5%89%8D%E3%82%92%E3%82%AB%E3%82%A6%E3%83%B3%E3%83%88%E3%81%99%E3%82%8B%E3%81%AB%E3%81%AF%E3%81%A9%E3%81%86%E3%81%99%E3%82%8C%E3%81%B0%E3%81%84%E3%81%84%E3%81%A7%E3%81%99%E3%81%8B.png)
私は VBA の初心者です。範囲内でコンマとスペースで区切られた一意の名前をカウントしたいのですが、同じ Web サイトから UDF を取得しましたが、1 つのセルしか調べられません。
Function ListCount(list As String, delimiter As String) As Long
Dim arr As Variant
arr = Split(list, delimiter)
ListCount = UBound(arr) - LBound(arr) + 1
End Function
Function RemoveDuplicates(list As String, delimiter As String) As String
Dim arrSplit As Variant, i As Long, tmpDict As New Dictionary, tmpOutput As String
arrSplit = Split(list, delimiter)
For i = LBound(arrSplit) To UBound(arrSplit)
If Not tmpDict.Exists(arrSplit(i)) Then
tmpDict.Add arrSplit(i), arrSplit(i)
tmpOutput = tmpOutput & arrSplit(i) & delimiter
End If
Next i
If tmpOutput <> "" Then tmpOutput = Left(tmpOutput, Len(tmpOutput) - Len(delimiter))
RemoveDuplicates = tmpOutput
'housekeeping
Set tmpDict = New Dictionary
End Function
誰かセルの範囲を変更できますか。ありがとう、ラオ
答え1
この数式は、すべての vba も置き換えます。
=SUMPRODUCT(--(ISERROR(FIND(TRIM(MID(SUBSTITUTE(TEXTJOIN(",",TRUE,A:A),",",REPT(" ",999)),(ROW(1:100)-1)*999+1,999)),MID(SUBSTITUTE(TEXTJOIN(",",TRUE,A:A),",",REPT(" ",999)),1,(ROW(1:100)-1)*999)))))
TEXTJOIN は Office 365 Excel で導入されました。お持ちでない場合は、この関数を模倣した次のコードを使用します。
Function TEXTJOIN(delim As String, skipblank As Boolean, arr)
Dim d As Long
Dim c As Long
Dim arr2()
Dim t As Long, y As Long
t = -1
y = -1
If TypeName(arr) = "Range" Then
arr2 = arr.Value
Else
arr2 = arr
End If
On Error Resume Next
t = UBound(arr2, 2)
y = UBound(arr2, 1)
On Error GoTo 0
If t >= 0 And y >= 0 Then
For c = LBound(arr2, 1) To UBound(arr2, 1)
For d = LBound(arr2, 1) To UBound(arr2, 2)
If arr2(c, d) <> "" Or Not skipblank Then
TEXTJOIN = TEXTJOIN & arr2(c, d) & delim
End If
Next d
Next c
Else
For c = LBound(arr2) To UBound(arr2)
If arr2(c) <> "" Or Not skipblank Then
TEXTJOIN = TEXTJOIN & arr2(c) & delim
End If
Next c
End If
TEXTJOIN = Left(TEXTJOIN, Len(TEXTJOIN) - Len(delim))
End Function