Question

        Sub arraytestingwow()
            Dim countertest As Integer
            Dim countermax As Integer
            Dim arraysuper(1 To 6, 0 To 4) As Variant

            countermax = 6

            For countertest = 1 To countermax

                    arraysuper(countertest, 0) = Range("a1").Offset(countertest, 0)
                    arraysuper(countertest, 1) = Range("b1").Offset(countertest, 0)
                    arraysuper(countertest, 2) = Range("c1").Offset(countertest, 0)
                    arraysuper(countertest, 3) = Range("d1").Offset(countertest, 0)
                    arraysuper(countertest, 4) = Range("e1").Offset(countertest, 0)

            Next

            Range("G1:K" & countermax - 1).Value = arraysuper

            'arraysuper.interior.colorindex = 3?????? Set all values not blank with color
        End Sub

我的行中有标题，所以我为它编码。如何使我的数组中非空白的所有值都有颜色？将有超过100,000行，所以我正在寻找最好的方法（否则我会使用带有if语句的循环）

Answer 1

您可以为所有细胞着色，然后擦除空白。这是一个如何获取一块单元格的空白的演示。首先运行top程序将一些数据写入工作表，并带有一些漏洞。

Sub SetUpSwissCheeseData_RunOnceToBegin()

    Dim ws As Excel.Worksheet
    Set ws = ActiveSheet

    Dim rng As Excel.Range
    Set rng = ws.Range(ws.Cells(1, 1), ws.Cells(3, 3))

    Dim vData As Variant
    vData = Application.Evaluate("{1,2,3;4,5,6;7,8,9}")

    rng.Value2 = vData
    rng.Cells(1, 2).Value = Null
    rng.Cells(2, 1).Value = Null
    rng.Cells(3, 3).Value = Null

End Sub

Sub GetBlanks()

    Dim ws As Excel.Worksheet
    Set ws = ActiveSheet

    Dim rng As Excel.Range
    Set rng = ws.Range(ws.Cells(1, 1), ws.Cells(3, 3))

    Dim rngBlanks As Excel.Range
    Set rngBlanks = rng.SpecialCells(xlCellTypeBlanks)

    Debug.Assert rngBlanks.Address = "$B$1,$A$2,$C$3"
    Stop


End Sub

为数组中的所有值着色

1 个答案: