Макрос не делится, как следует - неправильный вывод - PullRequest
Новая
       14

Макрос не делится, как следует - неправильный вывод

0 голосов
/ 06 января 2019

У меня есть макрос, который не производит вывод, который должен быть. В моем примере листа Excel ниже, код делит количество ячеек в D30 на 10 разных ячеек, равное до 12.00 после 12.00, избыточное количество должно идти в ячейку с использованием первого числа из двух в ячейке B30 (1 в этот пример). Правильный вывод указан в образце JPEG. В приведенном ниже примере листа посмотрите ожидаемый результат, чтобы увидеть, что производит текущий выходной сигнал.

Нажмите здесь для изображения Excel. 

Sub DIVIDE()
Application.ScreenUpdating = False

Dim pair As Variant, accumulator As Variant
Dim findFifteen As Double
Dim remainder As Long, found As Long

found = 1

For Each pair In Range("B30, F30, J30")
If Right(pair, 2) = 15 Then
    If pair.Offset(0, 2) <= 12 Then
        findFifteen = pair.Offset(0, 2) / 10
        remainder = 0
    Else
        findFifteen = 1
        remainder = pair.Offset(0, 2) Mod 10
    End If

    For Each accumulator In Range("A36, D36, G36, J36, M36, A40, D40, G40, J40, M40")
        If accumulator.Offset(-1, 0) = Val(Left(pair, InStr(pair, "-") - 1)) Then
            accumulator.Value = accumulator.Value + remainder
        End If
        accumulator.Value = accumulator.Value + findFifteen
    Next accumulator
    End If
Next pair

Application.ScreenUpdating = True
End Sub

1 Ответ

0 голосов
/ 07 января 2019

Я понятия не имею, что делает ваш код, но попробуйте следующее. Это дает мне ожидаемый результат. 

Option Explicit

Sub DivideSomeStuff()

    Dim pair As Range, accumulator As Range
    Dim findFifteen As Double
    Dim remainder As Long

    For Each pair In Range("B30, F30, J30")
        If Right(pair, 2) = 15 Then
            If pair.Offset(0, 2) <= 12 Then
                remainder = 0
            Else
                remainder = pair.Offset(0, 2) Mod 12
            End If

            findFifteen = (pair.Offset(0, 2) - remainder) / 10

            For Each accumulator In Range("A36, D36, G36, J36, M36, A40, D40, G40, J40, M40")
                If accumulator.Offset(-1, 0) = Val(Left(pair, InStr(pair, "-") - 1)) Then
                    accumulator.Value = accumulator.Value + remainder
                End If
                accumulator.Value = accumulator.Value + findFifteen
            Next accumulator
        End If
    Next pair

End Sub

Вам, вероятно, следует проверить другие значения в ячейке D30, чтобы убедиться, что вывод по-прежнему правильный / как ожидалось.

Я до сих пор не знаю, что делает ваш код, но если вы измените ячейки B30, F30 и J30 на вашем листе, чтобы они заканчивались цифрой 7 (например, какой-нибудь текст, например "1-7") и изменились NUMBER_TO_CHANGE к тому же значению (7 в данном случае), тогда я думаю, что код ниже даст ожидаемый результат. 

Option Explicit

Sub DivideSomeStuff()
    Const NUMBER_TO_CHANGE As Long = 7 ' Change this as needed

    Dim remainder As Long
    Dim pair As Range
    For Each pair In Range("B30, F30, J30")

        If Right(pair, Len(CStr(NUMBER_TO_CHANGE))) = NUMBER_TO_CHANGE Then
            If pair.Offset(0, 2) <= 12 Then
                remainder = 0
            Else
                remainder = pair.Offset(0, 2) Mod 12
            End If

            Dim findFifteen As Double
            findFifteen = (pair.Offset(0, 2) - remainder) / 10

            Dim accumulator As Range
            For Each accumulator In Range("A36, D36, G36, J36, M36, A40, D40, G40, J40, M40")
                If accumulator.Offset(-1, 0) = Val(Left(pair, InStr(pair, "-") - 1)) Then
                    accumulator.Value = accumulator.Value + remainder
                End If
                accumulator.Value = accumulator.Value + findFifteen
            Next accumulator
        End If

    Next pair
End Sub

Code's output

...