Excel VBA сложение и вычитание значений в разных ячейках - PullRequest
Новая
       19

Excel VBA сложение и вычитание значений в разных ячейках

0 голосов
/ 12 декабря 2011

Я работаю над своего рода расписанием в Excel.В этом листе вводятся человеко-дни для определенных экспертов и видов деятельности.Часто случается, что человеко-дни должны быть смещены между экспертами и деятельностью.Часть, с которой я застрял - это актуальное обновление значений в ячейках.Идея состоит в том, что все строки в моем первом массиве представляют номера строк.Я перебираю каждую ячейку в диапазоне, ищу значение и вычитаю сменные дни.Если дни смены превышают значение ячейки, я перехожу к следующему и так далее, пока не будут потрачены все дни.Вторая процедура использует ту же систему, но увеличивает количество человеко-дней.Моя проблема заключается в том, что количество человеко-дней для исходной активности увеличивается, а затем уменьшается, но целевая активность должна быть увеличена, а исходная активность уменьшена.

Структура листа, чтобы получить представление - часть в скобках должна бытьобновлено: 

     M1 M2 M3 ... EXP1 EXP2 EXP3
A1[  1  1  1  ]    3 
A2[  1     1  ]         2
A3[        1  ]              1

Код для сокращения человеко-дней: 

ReduceDaysCounter = ShiftDays

For row = UBound(FirstExpRowNumbers) To 0 Step -1  
    If FirstExpRowNumbers(row) > 0 And FirstExpRowNumbers(row) <= LastRow() Then
        For col = ExpertColumns(0) - 1 To 5 Step -1
            CurrCellValue = cells(FirstExpRowNumbers(row), col).Value
            If CurrCellValue > 0 And ReduceDaysCounter > 0 Then
                If ReduceDaysCounter >= CurrCellValue Then
                    cells(FirstExpRowNumbers(row), col).Value = 0
                    ReduceDaysCounter = ReduceDaysCounter - CurrCellValue
                End If
            End If
        Next
    End If
Next

Код для увеличения человеко-дней: 

IncreaseDaysCounter = ShiftDays

For row = 0 To UBound(SecondExpRowNumbers)  
    If SecondExpRowNumbers(row) > 0 And SecondExpRowNumbers(row) <= LastRow() Then
        For col = 5 To ExpertColumns(0) - 1
            CurrCellValue = cells(SecondExpRowNumbers(row), col).Value
            If CurrCellValue > 0 And IncreaseDaysCounter > 0 Then
                'If CurrCellValue < 2 Then
                    cells(SecondExpRowNumbers(row), col).Value = CurrCellValue + 1
                    IncreaseDaysCounter = IncreaseDaysCounter - 1
                'End If
            End If
        Next
    End If
Next

1 Ответ

0 голосов
/ 13 декабря 2011

Хорошо, я нашел проблему. Это функция для поиска правильного номера: 

Function FindingSDExpRow(actrow, expname)

Dim SDExpRow As Integer
SDExpRow = 0

Do While SDExpRow = 0
    actrow = actrow + 1
    If Left((cells(actrow, 2).Value), Len(expname)) = expname Then
        SDExpRow = cells(actrow, 2).row
    End If
Loop

FindingSDExpRow = SDExpRow

End Function

И тогда это довольно просто - модифицированный код для обновления значений ячеек: 

ReduceDaysCounter = ShiftDays

For col = ExpertColumns(0) - 1 To 5 Step -1
    CurrCellValue = cells(FirstExpRow, col).Value
    If CurrCellValue > 0 And ReduceDaysCounter > 0 Then
        If ReduceDaysCounter >= CurrCellValue Then
            cells(FirstExpRow, col).Value = 0
            ReduceDaysCounter = ReduceDaysCounter - CurrCellValue
        End If
    End If
Next

IncreaseDaysCounter = ShiftDays

For col = 5 To ExpertColumns(0) - 1
    CurrCellValue = cells(SeconExpRow, col).Value
    If CurrCellValue > 0 And IncreaseDaysCounter > 0 Then
        cells(SeconExpRow, col).Value = CurrCellValue + 1
        IncreaseDaysCounter = IncreaseDaysCounter - 1
    End If
Next
...