填写时间表中的空单元格

Question

我正在帮助我的经理处理人事规划文件，该文件有 3 个维度：员工、周和项目名称。

我想填写项目开始日期和结束日期之间的空白单元格（请参见突出显示的部分）。我编写了下面的代码，但它用第一个项目名称替换了第二个项目名称。 （例如，员工 1 为项目 1/项目 2，员工 2 为项目 3/项目 6），并将其复制到最后一个项目结束。

我如何校对我的代码并改进它以完成其设计目的？

Sub FillProjectDate_TEST1()
    Dim ws As Worksheet
    Dim lastRow As Long, lastCol As Long
    Dim i As Long, j As Long
    Dim startDate As Date, endDate As Date
    Dim project As String
    
    Set ws = ThisWorkbook.Sheets("Timeline") 
    
    ' Find the last row and last column with data

    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).row
    lastCol = ws.Cells(3, ws.Columns.Count).End(xlToLeft).Column
    
    ' Loop through each row starting from row 4
    For i = 4 To lastRow
        ' Reset start and end dates for each row
        startDate = 0
        endDate = 0
        
        ' Loop through each column (week). First week is in column B.
        For j = 2 To lastCol
            ' Check if the cell has a project name
            If ws.Cells(i, j).Value <> "" Then
                ' If start date is not set, set it
                If startDate = 0 Then
                    startDate = ws.Cells(3, j).Value
                    project = ws.Cells(i, j).Value ' Store project name
                End If
                
                ' Always update end date to the current date
                endDate = ws.Cells(3, j).Value
            End If
        Next j
        
        ' Fill in cells between start and end dates with project name
        If startDate <> 0 And endDate <> 0 Then
            For j = 1 To lastCol
                If ws.Cells(3, j).Value >= startDate And ws.Cells(3, j).Value <= endDate Then
                    ws.Cells(i, j).Value = project
                End If
            Next j
        End If
    Next i
End Sub

Answer 1

• 代码是基于我对你的猜测

Option Explicit

Sub FillProjectDate_TEST1()
    Dim ws As Worksheet
    Dim lastRow As Long, lastCol As Long
    Dim i As Long, j As Long
    Dim startCol As Long, endCol As Long
    Dim project As String
    Set ws = ThisWorkbook.Sheets("Timeline")
    ' Find the last row and last column with data
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    lastCol = ws.Cells(3, ws.Columns.Count).End(xlToLeft).Column
    ' Loop through each row starting from row 4
    For i = 4 To lastRow
        ' Reset start and end dates for each row
        startCol = 0: endCol = 0
        ' Loop through each column (week). First week is in column B.
        For j = 2 To lastCol
            ' Check if the cell has a project name
            If ws.Cells(i, j).Value <> "" Then
                ' If start date is not set, set it
                If StartDate = 0 Then
                    startCol = j
                    project = ws.Cells(i, j).Value ' Store project name
                Else
                    If startCol * endCol > 0 Then
                        ws.Cells(3, startCol).Resize(1, startCol - endCol + 1).Value = project
                    End If
                End If
                ' Always update end date to the current date
                endCol = j
            End If
        Next j
        ' Fill in cells for the last project name in each row
        If startCol * endCol > 0 Then
            ws.Cells(3, startCol).Resize(1, startCol - endCol + 1).Value = project
        End If
    Next i
End Sub