Excel Slider Control: Как я могу ограничить сумму всех ползунков, скажем, до 100? - PullRequest
3 голосов
/ 15 июня 2011

См. Изображение для наглядности.

Slider

У меня есть 5 переменных (A, B, C, D и E), каждая из которых может варьироваться от 0 до 100. Мне нужно, чтобы сумма всех этих переменных была всегда 100, не больше, не меньше. Однако, как он настроен в настоящее время, если я изменяю переменную A с 21 на, скажем, 51, общая сумма становится 130.

Как я могу настроить это так, чтобы, если я изменяю одну переменную, другие могли автоматически компенсировать это увеличение или уменьшение, таким образом, чтобы сумма составляла всегда 100?

1 Ответ

4 голосов
/ 15 июня 2011

Используйте события «Смена ползунка», чтобы при изменении значения одного ползунка другие масштабировались, чтобы значения суммировались до 100

.

Пример кода с использованием 3 ползунков - вы можете масштабировать его, чтобы включить столько ползунков, сколько хотите

Private UpdateSlider As Boolean

Private Sub ScaleSliders(slA As Double, ByRef slB As Double, ByRef slC As Double)
    Dim ScaleFactor As Double
    If (slB + slC) = 0 Then
        ScaleFactor = (100# - slA)
        slB = ScaleFactor / 2
        slC = ScaleFactor / 2

    Else
        ScaleFactor = (100# - slA) / (slB + slC)

        slB = slB * ScaleFactor
        slC = slC * ScaleFactor
    End If
End Sub


Private Sub ScrollBar1_Change()
    Dim slB As Double, slC As Double
   ' UpdateSlider = False
    If Not UpdateSlider Then
        slB = ScrollBar2.Value
        slC = ScrollBar3.Value
        ScaleSliders ScrollBar1.Value, slB, slC
        UpdateSlider = True
        ScrollBar2.Value = slB
        ScrollBar3.Value = slC
        UpdateSlider = False
    End If
End Sub

Private Sub ScrollBar2_Change()
    Dim slB As Double, slC As Double
    If Not UpdateSlider Then
        slB = ScrollBar1.Value
        slC = ScrollBar3.Value
        ScaleSliders ScrollBar2.Value, slB, slC
        UpdateSlider = True
        ScrollBar1.Value = slB
        ScrollBar3.Value = slC
        UpdateSlider = False
    End If
End Sub

Private Sub ScrollBar3_Change()
    Dim slB As Double, slC As Double
    If Not UpdateSlider Then
        slB = ScrollBar1.Value
        slC = ScrollBar2.Value
        ScaleSliders ScrollBar1.Value, slB, slC
        UpdateSlider = True
        ScrollBar1.Value = slB
        ScrollBar2.Value = slC
        UpdateSlider = False
    End If
End Sub

Обратите внимание, что ползунки типа данных целочисленные, поэтому может потребоваться разрешить округление без суммирования точно до 100

...