excel vba添加和減去不同單元格中的值

Question

我正在使用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 

Answer 1

好的，我發現了這個問題。這是找到正確的ROWNUMBER功能：

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