Excel VBA代码编辑以在单独的列中显示两个或多个值

时间:2016-09-26 10:19:18

标签: excel vba excel-vba

我使用下面的代码完美运行但我希望它在同一行的不同列中的不同单元格中显示两个或更多绿色(RGB(0,176,80))单元格值,而不是在带+符号的相同单元格?

Option Explicit

Sub main()
    Dim row As ListRow
    Dim icol As Long
    Dim formula As String

    For Each row In ActiveSheet.ListObjects("MyTable").ListRows
        formula = ""
        For icol = 1 To row.Range.Count - 1
            With row.Range(1, icol)
                If .Interior.Color = RGB(0, 176, 80) Then formula = formula & .value & "+" '.Address(False, False)
            End With
        Next icol
        If formula <> "" Then row.Range(1, icol).value = Left(formula, Len(formula) - 1)
    Next row
End Sub

1 个答案:

答案 0 :(得分:0)

试试这个

Option Explicit

Sub main()
    Dim row As ListRow
    Dim nCols As Long, icol As Long
    Dim formula As String
    Dim arr As Variant

    With ActiveSheet.ListObjects("MyTable") '<--| reference your table
        nCols = .ListColumns.Count - 1 '<-- "fix" its initial columns number since subsequent operations will increase it
        For Each row In .ListRows
            formula = ""
            For icol = 1 To nCols
                With row.Range(1, icol)
                    If .Interior.Color = RGB(0, 176, 80) Then formula = formula & .Value & "+" '.Address(False, False)
                End With
            Next icol
            If formula <> "" Then
                arr = Split(Left(formula, Len(formula) - 1), "+") '<--| fill an array with 'formula' string elements separated by "+"
                row.Range(1, icol).Resize(, UBound(arr) + 1).Value = arr '<--| write array content into current row last column adjacent cells
            End If
        Next row
    End With
End Sub