Excel vba добавление и вычитание значений в разных ячейках

Я работаю над своего рода списком расписания в 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 ответ

Хорошо, я нашел проблему. Это функция, чтобы найти правильный номер журнала:

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

licensed under cc by-sa 3.0 with attribution.