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

excel vba在不同的单元格中添加和减去值

1 个答案: