Excel 2007 VBA Cell.interior, чередующийся на основе последовательного вычисления ячеек - PullRequest
0 голосов
/ 12 марта 2012

Я сделаю все от меня зависящее, чтобы сделать это коротким и сладким. У меня есть лист Excel, который должен суммировать ячейки, пока не достигнет цели. Тогда эти клетки нуждаются в наборе цветов интерьера. Затем вычисления сбрасываются, затем продолжаются вниз по диапазону, пока следующий цикл ячеек не станет равным цели. Интерьер должен установить другой цвет для этого набора. Это будет чередоваться через диапазон. У меня это около 90%, но второй цвет только выделяется для начала сета, а затем продолжается с первым цветом. Заранее спасибо за любые указатели

У меня есть:

Sub calctarget()
    Dim x As Variant
    Dim xsub As Variant
    Dim total  As Double
    Dim y As Variant
    Dim target As Double
    Dim RunTotal As Double

    target = 44500

    If RunTotal < target Then y = 0
    RunTotal = 0
    For Each y In Range("a1:a15")
        On Error Resume Next
        RunTotal = RunTotal + y.Value
        If RunTotal < target Then
            y.Interior.ColorIndex = 4
        End If
        If RunTotal > target Then
            RunTotal = RunTotal - y
            If y.Offset(-1, 0).Interior.ColorIndex = 4 Then
                RunTotal = 0
                If RunTotal = 0 Then y.Interior.ColorIndex = 5
                RunTotal = RunTotal + y
            End If
        End If
    Next y
End Sub

1 Ответ

1 голос
/ 12 марта 2012

Это может быть то, что вам нужно (он чередует цвета при каждом достижении цели и переносит баланс вперед, если есть):

Sub calctarget()
    Dim c As Range
    Dim target As Double
    Dim runTotal As Double
    Dim currentColor As Long

    target = 44500
    currentColor = 4

    For Each c In Range("a1:a15")
        If IsNumeric(c) Then
            runTotal = runTotal + c
        End If
        If runTotal >= target Then 'Target reached
            currentColor = IIf(currentColor = 4, 5, 4) 'alternate colors (4 and 5)
            runTotal = runTotal - target 'maybe you want to start from 0 again?
        End If
        c.Interior.ColorIndex = currentColor
    Next c
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...