VBA连接填充条件的选定单元格

我正在尝试用VBA编写一个函数，它允许我连接单元格并在元素之间添加一个“，”。该函数的另一个方面是，我只想连接与选定范围内第一个单元格具有相同填充颜色和字体颜色的单元格。（我的电子表格有一个标签列表，这些标签位于具有不同颜色和字体颜色的单元格中）。 如果在网上找到一个代码，而该代码在不具备任何条件的情况下工作，则惊奇漫画。但当我尝试添加它们时，它返回一个值错误。 以下是我的功能：

Function Concat(rng As Range) As String 
     Dim rngCell As Range
     Dim strResult As String
     Dim bcolor As Long
     Dim fcolor As Long
     bcolor = rng.Cells(1, 1).Interior.ColorIndex
     fcolor = rng.Cells(1, 1).Font.ColorIndex
     For Each rngCell In rng
         If rngCell.Value <> "" And rngCell.Interior.ColorIndex = bcolor And rngCell.Font.ColorIndex = fcolor Then
            strResult = strResult & "," & rngCell.Value
         End If
     Next rngCell
     If rngCell.Value <> "" And rngCell.Interior.ColorIndex = rng.Cells(1, 1).Interior.ColorIndex And rngCell.Font.ColorIndex = rng.Cells(1, 1).Font.ColorIndex Then
         strResult = Mid(strResult, Len(",") + 1)
     End If
     Concat = strResult
End Function

我知道这里有一些基本的VBA编码我不理解。但我不知道是什么。如果你看到什么是错误的，我将感谢你的纠正和解释我的错误是什么。 谢谢

---

Xavier

对于Concat（）要返回值，您的函数必须为函数体中的变量赋值。

我不确定代码的最后一部分是否符合您的要求。此外，对于rng中的每个rngCell，不能在

之外使用
rngCell

语句内部仅删除字符串的第一个字符。（
Mid（）
截断从传入参数位置的字符开始的字符串，如果要提供第二个数字，它将设置子字符串将包含的字符数；
Len（）
将返回所提供字符串的长度）

因此，
strResult=Mid（strResult，Len（“，”）+1）
几乎意味着存储原始字符串的字符串，但从字符2（1+1）开始

试试这个

Function Concat(rng As Range) As String
     Dim rngCell As Range
     Dim strResult As String
     Dim bcolor As Long
     Dim fcolor As Long
     bcolor = rng.Cells(1, 1).Interior.ColorIndex
     fcolor = rng.Cells(1, 1).Font.ColorIndex
     For Each rngCell In rng

         If rngCell.Value <> "" And rngCell.Interior.ColorIndex = bcolor And rngCell.Font.ColorIndex = fcolor Then
            If strResult = "" Then
                strResult = rngCell.Value
            Else
                strResult = strResult & ", " & rngCell.Value
            End If
         End If

     Next rngCell
     'this probably doesn't do what you want, so I commented it out.
     'If rngCell.Value <> "" And rngCell.Interior.ColorIndex = rng.Cells(1, 1).Interior.ColorIndex And rngCell.Font.ColorIndex = rng.Cells(1, 1).Font.ColorIndex Then
     '    strResult = Mid(strResult, Len(",") + 1)
     'End If
     Concat = strResult
End Function

函数Concat（rng作为范围）作为字符串
Dim rngCell As范围
作为字符串的Dim strResult
暗淡的B色如长
暗淡的颜色和长的一样
b颜色=rng.Cells（1,1）.Interior.ColorIndex
fcolor=rng.Cells（1,1）.Font.ColorIndex
对于rng中的每个rng单元
如果rngCell.Value“”和rngCell.Interior.ColorIndex=bcolor和rngCell.Font.ColorIndex=fcolor，则
如果strResult=“”，则
strResult=rngCell.Value
其他的
strResult=strResult&“，”和rngCell.Value
如果结束
如果结束
下一个rngCell
这可能不是你想要的，所以我把它注释掉了。
'如果rngCell.Value“”和rngCell.Interior.ColorIndex=rng.Cells（1,1）.Interior.ColorIndex和rngCell.Font.ColorIndex=rng.Cells（1,1）.Font.ColorIndex，则
'stresult=Mid（stresult，Len（“，”）+1）
"完"
Concat=strResult
端函数
是的，很抱歉，我更改了函数名称以使其更具可读性，但忘记在代码中更改它。我用的是同一个名字。谢谢你指出！我编辑了这个问题。谢谢你的回答，我会马上试用你的代码。这里有额外if的原因是，否则，返回的字符串以“，”开头。我会在试用完这个函数后再回来。实际上，在试用之后，我了解的更少。编译时，编译器告诉我有一个错误，因为有一个Next没有For（这显然不是真的），因为只有一个Next和一个For！阅读您的代码，我确实认为删除第一个“，”要优雅得多！实际上，在添加了If之后，缺少了结束If的错误原因。代码有效！哦，天哪。。也许我应该更加勤奋地测试：）如果您有时间解释为什么在If中添加这些补充条件会破坏我的代码，我们将不胜感激：）
Function color1(rng As Range) As Long
    color1 = rng.Cells(1, 1).Font.ColorIndex
End Function

Function Concat(rng As Range) As String
     Dim rngCell As Range
     Dim strResult As String
     Dim bcolor As Long
     Dim fcolor As Long
     bcolor = rng.Cells(1, 1).Interior.ColorIndex
     fcolor = rng.Cells(1, 1).Font.ColorIndex
     For Each rngCell In rng

         If rngCell.Value <> "" And rngCell.Interior.ColorIndex = bcolor And rngCell.Font.ColorIndex = fcolor Then
            If strResult = "" Then
                strResult = rngCell.Value
            Else
                strResult = strResult & ", " & rngCell.Value
            End If
         End If

     Next rngCell
     'this probably doesn't do what you want, so I commented it out.
     'If rngCell.Value <> "" And rngCell.Interior.ColorIndex = rng.Cells(1, 1).Interior.ColorIndex And rngCell.Font.ColorIndex = rng.Cells(1, 1).Font.ColorIndex Then
     '    strResult = Mid(strResult, Len(",") + 1)
     'End If
     Concat = strResult
End Function