[已解决]如何用V判断有颜色数字及位置

fjmxwrs

可否在数组中进行判断？谢谢

Oc4NE2Wd.rar (7.22 KB, 下载次数: 114)

2010-11-29 14:32 上传

点击文件名下载附件
求助，如何判断字体颜色

最佳答案

月排行榜 / 总排行榜

龙猫

2010-11-29 15:03

[hide]弱弱的说
颜色，是属于单元格的属性吧
数组赋值是不能把单元格的格式、颜色、边框等属性都包括的吧 背了这么重的包袱，数组也飞不起来了
数组可以放 单元格属性的值、行（列）值
说错了 不要打偶屁屁
[em04][em04][em04]
Sub 按钮1_Click()
    Dim arr(1 To 1000, 1 To 3), X, K%
    For Each X In Range("b1:d11")
        If Len(X) <> 0 Then
            If X.Font.ColorIndex <> 1 Then
                K = 1 + K
                If K = 1 Then
                    arr(K, 1) = "有色数字值"
                    arr(K, 2) = "地址"
                    arr(K, 3) = "颜色号"
                End If
                arr(K + 1, 1) = X.Value
                arr(K + 1, 2) = X.Address
                arr(K + 1, 3) = X.Font.ColorIndex
            End If
        End If
    Next
    Range("E1").Resize(K + 1, 3) = arr
End Sub[/hide
]

[此贴子已经被作者于2010-11-29 15:35:38编辑过]

跳转到最佳答案楼层

龙猫

[hide]弱弱的说
颜色，是属于单元格的属性吧
数组赋值是不能把单元格的格式、颜色、边框等属性都包括的吧 背了这么重的包袱，数组也飞不起来了
数组可以放 单元格属性的值、行（列）值
说错了 不要打偶屁屁
[em04][em04][em04]
Sub 按钮1_Click()
    Dim arr(1 To 1000, 1 To 3), X, K%
    For Each X In Range("b1:d11")
        If Len(X) <> 0 Then
            If X.Font.ColorIndex <> 1 Then
                K = 1 + K
                If K = 1 Then
                    arr(K, 1) = "有色数字值"
                    arr(K, 2) = "地址"
                    arr(K, 3) = "颜色号"
                End If
                arr(K + 1, 1) = X.Value
                arr(K + 1, 2) = X.Address
                arr(K + 1, 3) = X.Font.ColorIndex
            End If
        End If
    Next
    Range("E1").Resize(K + 1, 3) = arr
End Sub[/hide
]

[此贴子已经被作者于2010-11-29 15:35:38编辑过]

轩辕轼轲

[hide]Sub 按钮1_Click()
Dim arr(1 To 44, 1 To 2)
Dim i, j, m As Integer
m = 1
For i = 1 To 11
    For j = 1 To 4
        If Val(Cells(i, j)) And Cells(i, j).Font.ColorIndex = 3 Then
        arr(m, 1) = Cells(i, j).Address
        arr(m, 2) = Cells(i, j).Font.ColorIndex
        m = m + 1
        End If
    Next j
Next i
Range("H1").Resize(UBound(arr), 2) = arr
End Sub[/hide
]

lyn666666

[hide] Sub 按钮1_Click()
Dim rng As Range
For Each rng In Sheet1.UsedRange
    If rng.Font.ColorIndex > 1 Then
        MsgBox rng.Value & rng.Address
    End If
Next
End Sub

看看别人的答案是否用数组

[/hide
]

dongqing1998

Sub test()
    Dim k%, arr(), rng As Range
    For Each rng In Range("b2:d11")
        If rng.Font.ColorIndex = 3 Then
            k = k + 1
            ReDim Preserve arr(1 To 3, 0 To k)
            arr(1, k) = rng.Value
            arr(2, k) = rng.Address
            arr(3, k) = rng.Font.ColorIndex
        End If
    Next
    arr(1, 0) = "数字"
    arr(2, 0) = "单元格地址"
    arr(3, 0) = "色值"
    Range("F1").Resize(UBound(arr), 3) = Application.Transpose(arr)
End Sub

jb_008

为会么不回复就看不到呢

davicl_yi

干嘛都要回复才能看得到呢