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的新手(我今天下午开始),所以我添加bcolor和fcolor的原因是为了调试。事实上,我认为VBA中有一些基本的东西我不理解,因为即使是下面的函数也不会返回任何值:

Function Concat(rng As Range) As Long 'Replace "Long" by "String" after debug is over
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 = bcolor
End Function

这个函数不返回单元格的颜色,而下面的函数则返回:,这真的让我很恼火

Function color1(rng As Range) As Long
color1 = rng.Cells(1, 1).Font.ColorIndex
End Function

我知道VBA编码有一些基本的我不理解的地方。但我不知道是什么。如果你看到了错误,我希望你能纠正并解释我的错误。谢谢Xavier

我不确定代码的最后一部分做了你想做的事情。此外,你不能在For Each rngCell In rng之外使用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()要返回值,函数必须为函数体中的变量赋值。

最新更新