将数据添加到表中时，我无法将值从一个单元格转移到另一个单元格。 VBA 代码未优化

Question

我在 Excel 中有两个表格，一个名为“Calendar”，另一个名为“PlanTable”。

左表是日历，右表是计划表。

我想做的是根据该日期某台机器的计划来计算每个工人应该做多少工作。

让我举一个例子来澄清我想要做什么：
假设我们取日期为 2024 年 7 月 1 日，我们看到在那天的右表中，机器（在“Utilaj”列下）R1、R3 和 R9 工作，每个机器旁边是当天的计划（在“计划”栏下）。
之后，我们检查右表，了解有多少工人被分配到R1、R3，以及R9机器。
发现2024年7月1日，R1有2名工人，R3有1名工人，R9有3名工人。
每个工人旁边的值应该是（机器的计划/在特定日期在该机器上工作的工人数量）。

我成功地做到了这一点，但是当我将一个新人放入“日历”表中时，这些值不会随着工人的移动而变化，而且我似乎不知道该怎么做。

如果我的代码可以进行任何优化以使其更快，我非常高兴。

这是我的按钮代码：“Calculeaza Fapt”第四个按钮。

Sub Refresh()
    On Error GoTo ErrorHandler

    Dim ws As Worksheet
    Dim planTbl As ListObject
    Dim calendarTbl As ListObject
    Dim selectedDate As String
    Dim utilaj As String
    Dim r As Range
    Dim cell As Range
    Dim workerCount As Long
    Dim planValue As Double
    Dim faptValue As Double
    Dim workerDict As Object
    Dim utilajKey As Variant

    Set ws = ThisWorkbook.Sheets("Sheet1")
    Set planTbl = ws.ListObjects("PlanTable")
    Set calendarTbl = ws.ListObjects("Calendar")

    ' Initialize dictionary to count workers
    Set workerDict = CreateObject("Scripting.Dictionary")

    ' Loop through the dates in the PlanTable
    For Each r In planTbl.ListColumns("Data").DataBodyRange
        selectedDate = Format(r.Value, "dd-mmm-yy")
        Debug.Print "Processing date: " & selectedDate
        
        ' Reset workerDict for each date
        workerDict.RemoveAll
        
        ' Count the number of workers for each Utilaj on the selected date from the Calendar table
        For Each cell In calendarTbl.ListColumns("Data").DataBodyRange
            If Format(cell.Value, "dd-mmm-yy") = selectedDate Then
                utilaj = cell.Offset(0, calendarTbl.ListColumns("Utilaj").Index - calendarTbl.ListColumns("Data").Index).Value
                If workerDict.exists(utilaj) Then
                    workerDict(utilaj) = workerDict(utilaj) + 1
                Else
                    workerDict.Add utilaj, 1
                End If
            End If
        Next cell
        
        ' Debugging output
        For Each utilajKey In workerDict.Keys
            Debug.Print "Utilaj: " & utilajKey & ", Workers: " & workerDict(utilajKey)
        Next utilajKey
        
        ' Divide the Plan value by the number of workers and assign to the Fapt column in the Calendar table
        utilaj = r.Offset(0, planTbl.ListColumns("Utilaj").Index - planTbl.ListColumns("Data").Index).Value
        planValue = r.Offset(0, planTbl.ListColumns("Plan").Index - planTbl.ListColumns("Data").Index).Value

        If workerDict.exists(utilaj) Then
            workerCount = workerDict(utilaj)
            faptValue = planValue / workerCount

            ' Update the Calendar table
            For Each cell In calendarTbl.ListColumns("Data").DataBodyRange
                If Format(cell.Value, "dd-mmm-yy") = selectedDate And _
                   cell.Offset(0, calendarTbl.ListColumns("Utilaj").Index - calendarTbl.ListColumns("Data").Index).Value = utilaj Then
                    cell.Offset(0, calendarTbl.ListColumns("Plan").Index - calendarTbl.ListColumns("Data").Index).Value = faptValue
                End If
            Next cell

            Debug.Print "Assigned Fapt value: " & faptValue & " to Utilaj: " & utilaj
        Else
            Debug.Print "No workers found for Utilaj: " & utilaj & " on date: " & selectedDate
        End If
    Next r

    MsgBox "Values updated successfully!"

    Exit Sub

ErrorHandler:
    MsgBox "Error " & Err.Number & ": " & Err.Description
End Sub

我尝试使用 chatGpt 没有多大帮助

Answer 1

如果我正确理解了这个问题，我认为你不需要 VBA。

E 列的公式为：

=XLOOKUP(1,([@Data]=PlanTable[Data])*([@Utilaj]=PlanTable[Utilaj]),PlanTable[Plan])/COUNTIFS([Data],[@Data],[Utilaj],[@Utilaj])