搜索字符串范围，更改相邻单元格的值

Question

我似乎被困在看似非常简单的代码上。 我对 VB 很陌生，所以如果我做了一些非常愚蠢的事情，请耐心等待。

这是一个时间表，我全年每天都记录我的开始和结束时间。

因此，每年我都会制作 Excel 文件的新副本，并且我想覆盖我进入前一年的时间，默认开始时间是早上 7 点，结束时间是下午 4:30 我可能可以直接在 Excel 中使用“Vlookup”但是这个时间表是一个需要在 VBA 中提高技能的项目

“开始新工作表”按钮打开一个用户表单，用于输入其他一切正常的输入。

在 Private Sub TSSubmitButton_Click() 中，我定义了我需要的范围和字符串，并For Each Cell in Range Find Monday制作了一些，然后将变量写入星期一开始时间 (07:00:00) 和星期一完成时间 (16 :45:00)

（例如只包括星期一和星期二）

调试不会标记任何错误，并且当代码运行时（即单击用户表单提交按钮）没有任何反应，所有时间值都保持原样。 我试过把“星期一作为字符串”变成“星期一作为日期”我试过没有Find(DayCell.Value)

Private Sub TSSubmitButton_Click()

' Definitions
Dim DayRange As Range
Dim DayCell As Range
Set DayRange = Sheet1.Range("A2:A426")
Set DayCell = DayRange(1, 1)

Dim MonStartTime As String
Dim MonFinishTime As String
Dim TueStartTime As String
Dim TueFinishTime As String
Dim WedStartTime As String
Dim WedFinishTime As String
Dim ThuStartTime As String
Dim ThuFinishTime As String
Dim FriStartTime As String
Dim FriFinishTime As String
Dim SatStartTime As String
Dim SatFinishTime As String
Dim SunStartTime As String
Dim SunFinishTime As String

Dim Monday As String
Dim Tuesday As String
Dim Wednesday As String
Dim Thursday As String
Dim Friday As String
Dim Satday As String
Dim Sunday As String

MonStartTime = "07:00:00"
MonFinishTime = "16:45:00"
TueStartTime = "07:00:00"
TueFinishTime = "16:45:00"
WedStartTime = "07:00:00"
WedFinishTime = "16:45:00"
ThuStartTime = "07:00:00"
ThuFinishTime = "16:45:00"
FriStartTime = "00:00:00"
FriFinishTime = "00:00:00"
SatStartTime = "00:00:00"
SatFinishTime = "00:00:00"
SunStartTime = "00:00:00"
SunFinishTime = "00:00:00"

    ' loops the if statement through all cells and sets the time in adjecnt cells
    For Each DayCell In DayRange.Find(DayCell.Value)
        If DayCell = Monday Then
        DayCell.Offset(, 2).Value = MonStartTime
        DayCell.Offset(, 7).Value = MonFinishTime
        End If
        
        ' loops the if statement through all cells and sets the time in adjecnt cells
    For Each DayCell In DayRange.Find(DayCell.Value)
        If DayCell = Tuesday Then
        DayCell.Offset(, 2).Value = TueStartTime
        DayCell.Offset(, 7).Value = TueFinishTime
        End If
     
Next
Unload Me

End Sub

Answer 1

我不知道你是否会喜欢这个解决方案！

1. 我将您的时间表范围转换为表格 object
2. 我为工作日的开始和结束时间创建了一个表格
3. 使用 XLOOKUP 公式，我得到开始和结束列的开始和结束时间。 代替 XLOOKUP 您可以使用 VLOOKUP 或 INDEX & MATCH

Sub ResetTimesheet()
    Dim ws As Worksheet
    Dim olWkDay As ListObject
    Dim olTimetable As ListObject
    Dim olCol As Long
    Dim olRng As Range
    
    Set ws = ActiveSheet
    
    'Tables
    Set olWkDay = ws.ListObjects("tbWkDayTime")
    Set olTimetable = ws.ListObjects("tbTimetable")
        
    ''''''''''''''''''''''''''''''''''''''''''''
    ' Start column
    ''''''''''''''''''''''''''''''''''''''''''''
    olCol = olTimetable.ListColumns("Start").Index
    Set olRng = olTimetable.ListColumns(olCol).DataBodyRange
    ' Clear column contents
    olRng.ClearContents
    ' Apply formula: you can use VLookup or Index & Match
    olRng.Formula2R1C1 = "=XLOOKUP([@Weekday],tbWkDayTime[Weekday],tbWkDayTime[StartTime])"
    ' Copy to values
    olRng.Copy
    olRng.PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    
    ''''''''''''''''''''''''''''''''''''''''''''
    ' Finish column
    ''''''''''''''''''''''''''''''''''''''''''''
    olCol = olTimetable.ListColumns("Finish").Index
    Set olRng = olTimetable.ListColumns(olCol).DataBodyRange
    ' Clear column contents
    olRng.ClearContents
    ' Apply formula: you can use VLookup or Index & Match
    olRng.Formula2R1C1 = "=XLOOKUP([@Weekday],tbWkDayTime[Weekday],tbWkDayTime[FinishTime])"
    ' Copy to values
    olRng.Copy
    olRng.PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    
    ' Clear
    Set olWkDay = Nothing
    Set olTimetable = Nothing
End Sub