Excel VBA在不同单元格中添加和减去值

问题描述：

我正在处理Excel中的一种调度表。在此工作表中，输入了某些专家和活动的工作日。通常情况下，必须在专家和活动之间转移工作日。我坚持的部分是单元格中值的实际更新。这个想法是我的第一个数组中的所有行都代表行号。我逐步检查范围内的每个单元格，寻找一个值并减去移动天数。如果移动的天数大于单元格的值，我将移至下一个，依此类推，直到所有天数都用完为止。第二个例程使用相同的系统，但是增加了工时。我的问题是源活动的人工天数先增加然后减少，但是目标活动的人工天数应该增加，源活动减少。

I am working on a kind of scheduling sheet in Excel. In this sheet man days for certain experts and activities are entered. It often occurs that man days have to be shifted between experts and activities. The part I am stuck with is the actual updating of values in the cells. The idea is that all the lines in my first array represent row numbers. I step through each cell in the range look for a value and subtract the shifting days. If the shifting days are greater than the cell value I move to the next and so on until all days are spent. The second routine uses the same system but increases the man days. My problem is that the man days for the source activity are increased and then decreased but the target activity should be increased and the source activity decreased.

获取工作表的结构这个想法-括号中的部分应该更新：

Structure of the sheet to get the idea - the part in brackets should be updated:

     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

答

好发现了问题。这是查找正确行号的函数：

Ok I found the problem. This is the function to find the correct 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

然后这很容易-修改了用于更新单元格值的代码：

And then it is rather easy - modified code for updating cell values:

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

Excel VBA在不同单元格中添加和减去值

相关推荐