如何查找指定日期后的周一并实现双表日期逻辑处理？

Got it, let's tackle your date handling requirements with a VBA solution that aligns with your initial code snippet. We'll break this down into reusable helper functions and clear main logic to keep things easy to follow and adjust.

1. Helper Function: Get the Next Monday After a Specified Date #

First, let's build a reusable function to grab the next Monday (or return the input date if it's already a Monday). This avoids regional date setting issues by explicitly using Monday as the week start:

Function GetNextMonday(ByVal inputDate As Date) As Date
    Dim dayOfWeek As Integer
    dayOfWeek = Weekday(inputDate, vbMonday) ' Treat Monday as day 1 of the week
    
    If dayOfWeek = 1 Then
        ' Input date is already a Monday
        GetNextMonday = inputDate
    Else
        ' Calculate days needed to jump to the next Monday
        GetNextMonday = inputDate + (8 - dayOfWeek)
    End If
End Function

2. Helper Function: Get the First Monday of the Current Month #

Next, we need a function to fetch the first Monday of the current month—this value will go at the top of both tables:

Function GetFirstMondayOfMonth() As Date
    Dim firstDayOfMonth As Date
    firstDayOfMonth = DateSerial(Year(Date), Month(Date), 1)
    
    Dim dayOfWeek As Integer
    dayOfWeek = Weekday(firstDayOfMonth, vbMonday)
    
    If dayOfWeek = 1 Then
        ' The first day of the month is already a Monday
        GetFirstMondayOfMonth = firstDayOfMonth
    Else
        ' Add days to reach the first Monday of the month
        GetFirstMondayOfMonth = firstDayOfMonth + (8 - dayOfWeek)
    End If
End Function

3. Main Logic: Process Table1 and Table2 #

Now let's put it all together to handle your table requirements. We'll assume your tables are Excel's standard structured ListObjects:

Sub ProcessTables()
    Dim ws As Worksheet
    Dim table1 As ListObject, table2 As ListObject
    Dim firstMonday As Date
    Dim targetRow As ListRow
    Dim colTab2Dat As Date ' Matches your initial code snippet
    
    ' Update these to match your actual worksheet and table names
    Set ws = ThisWorkbook.Worksheets("YourSheetName")
    Set table1 = ws.ListObjects("Table1")
    Set table2 = ws.ListObjects("Table2")
    
    ' Grab the first Monday of the current month
    firstMonday = GetFirstMondayOfMonth()
    
    ' Step 1: Insert the first Monday at the top of both tables
    ' Add row to Table1 and populate date column (adjust column index if needed)
    table1.ListRows.Add Position:=1
    table1.DataBodyRange(1, 1).Value = firstMonday
    
    ' Add row to Table2 and populate date column
    table2.ListRows.Add Position:=1
    table2.DataBodyRange(1, 1).Value = firstMonday
    
    ' Step 2: Traverse Table2 rows and apply your rules
    ' Skip the first row we just inserted (start from row 2)
    For Each targetRow In table2.ListRows
        If targetRow.Index = 1 Then GoTo NextRow
        
        ' Get the date from the current row's date column
        colTab2Dat = targetRow.Range(1).Value
        
        ' Rule 1: If date is greater than the top first Monday, insert 0
        If colTab2Dat > firstMonday Then
            targetRow.Range(2).Value = 0 ' Adjust column index to your value column
        End If
        
        ' Rule 2: If date is 16/02/2018 and not a Monday, update to next Monday and set value 1
        If colTab2Dat = DateSerial(2018, 2, 16) Then
            If Weekday(colTab2Dat, vbMonday) <> 1 Then
                targetRow.Range(1).Value = GetNextMonday(colTab2Dat)
                targetRow.Range(2).Value = 1
            End If
        End If
        
NextRow:
    Next targetRow
End Sub

Quick Adjustments to Make: #

• Replace YourSheetName, Table1, and Table2 with your actual worksheet and table names.
• Update column indices (like .Range(1) or .Range(2)) to match where your date column and value column live in the tables.
• We use DateSerial(2018, 2, 16) instead of the string "16/02/2018" to avoid regional date format conflicts.

内容的提问来源于stack exchange，提问作者user9351236