EXCEL VBA按颜色提取内容和颜色

Sub s()

    Set rg1 = [K14:T23]

    Set rg2 = [V3:w13]

    Set t = [m1:q1]

    x = 1

    y = 1

    For i = 1 To 5

        cl = t(i)InteriorColor

        kk = ""

        For j = 1 To rg1ColumnsCount

        For k = 1 To rg1RowsCount

            If rg1Cells(k, j)InteriorColor = cl Then

                If kk = "" Then

                    rg1Cells(k, j)Copy rg2Cells(x, y)

                    kk = rg1Cells(k, j)

                Else

                    rg2Cells(x, y) = kk & "/" & rg1Cells(k, j)

                    If x < rg2RowsCount Then

                        x = x + 1

                    Else

                        x = 1

                        y = y + 1

                    End If

                    kk = ""

                End If

            End If

        Next: Next

        If kk <> "" Then

            If x < rg2RowsCount Then

                x = x + 1

            Else

                x = 1

                y = y + 1

            End If

        End If

    Next

End Sub

条件3，我还没做完，以下代码可满足条件1和2

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Sub px()

Dim a1, a2, a3, a4, a5, a6, a7, a8, b1, b2, b3, b4, b5, b6, b7, b8 As Integer

a3 = 0

A9字符长度 = Len(Sheet1Cells(9, 1))

A10字符长度 = Len(Sheet1Cells(10, 1))

'a1定义为列的循环,按B列包含多少行有效数而定循环数

'a2定义为行循环 , 按A9和A10的个数而定循环次数

For a1 = 1 To 10

For a2 = 1 To A9字符长度

If Len(Sheet1Cells(a1, 2)) - Len(Replace(Sheet1Cells(a1, 2), Mid(Sheet1Cells(9, 1), a2, 1), "")) > 0 Then

'a3定义为一个累加变量，存放满足A9条件的次数

a3 = a3 + 1

End If

Next a2

'Sheet1Cells(a1, 3) = a3

If a3 = 3 Then

Sheet1Cells(a1, 2)FontColor = vbRed

End If

a3 = 0

Next a1

'a1定义为列的循环,按B列包含多少行有效数而定循环数

'a2定义为行循环 , 按A9和A10的个数而定循环次数

For a1 = 1 To 10

For a2 = 1 To A10字符长度

If Len(Sheet1Cells(a1, 2)) - Len(Replace(Sheet1Cells(a1, 2), Mid(Sheet1Cells(10, 1), a2, 1), "")) > 0 Then

'a3定义为一个累加变量，存放满足A9条件的次数

a3 = a3 + 1

End If

Next a2

'Sheet1Cells(a1, 4) = a3

If a3 = 3 Then

Sheet1Cells(a1, 2)FontColor = vbRed

End If

a3 = 0

Next a1

For a1 = 1 To 10

If Not Sheet1Cells(a1, 2)Find("05") Is Nothing Then

'Sheet1Cells(a1, 5) = 1

Sheet1Cells(a1, 2)FontColor = vbRed

End If

If Not Sheet1Cells(a1, 2)Find("50") Is Nothing Then

'Sheet1Cells(a1, 5) = 1

Sheet1Cells(a1, 2)FontColor = vbRed

End If

If Not Sheet1Cells(a1, 2)Find("24") Is Nothing Then

'Sheet1Cells(a1, 5) = 1

Sheet1Cells(a1, 2)FontColor = vbRed

End If

If Not Sheet1Cells(a1, 2)Find("42") Is Nothing Then

'Sheet1Cells(a1, 5) = 1

Sheet1Cells(a1, 2)FontColor = vbRed

End If

If Not Sheet1Cells(a1, 2)Find("69") Is Nothing Then

'Sheet1Cells(a1, 5) = 1

Sheet1Cells(a1, 2)FontColor = vbRed

End If

If Not Sheet1Cells(a1, 2)Find("96") Is Nothing Then

'Sheet1Cells(a1, 5) = 1

Sheet1Cells(a1, 2)FontColor = vbRed

End If

Next a1

End Sub

excel里，字体为自动黑色时，他默认的值为-4105

指定主题颜色中的黑色时，值为1

如果值为Null，系统默认该单元格的字体颜色为黑，没有值

所以-4105，1，Null都代表单元格字体颜色为黑色

以上就是关于EXCEL VBA按颜色提取内容和颜色全部的内容，包括:EXCEL VBA按颜色提取内容和颜色、excel中怎样用VBA实现单元格的字体显色、关于 vba 去单元格字体颜色 我明明把单元格字体设置了颜色为什么取不到 啊等相关内容解答，如果想了解更多相关内容，可以关注我们，你们的支持是我们更新的动力！