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

时间:2014-01-16 04:06:33

标签: vba excel-vba excel

我正在尝试在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编码不了解的基本知识。但我不知道是什么。如果你看到了什么问题,我会很感激纠正和解释我的错误。 谢谢! 泽维尔

2 个答案:

答案 0 :(得分:1)

我不确定代码的最后一部分是否符合您的要求。另外,您无法使用rngCell之外的For Each rngCell In rng

语句内部仅删除字符串的第一个字符。 (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

答案 1 :(得分:0)

要使 Concat()返回一个值,您的函数必须为函数体内的变量赋值。