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