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

Posted 2023-03-27

【中文标题】搜索字符串范围，更改相邻单元格的值

【英文标题】：Search range for string, change values of adjacent cells

【发布时间】：2022-01-24 00:53:52

【问题描述】：

我似乎被困在看似非常简单的代码上。我对 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

【参考方案1】：

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

我将您的时间表范围转换为表格对象 我为工作日的开始和结束时间创建了一个表格 使用 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

像这样改变For..Next

For Each DayCell In DayRange
    If DayCell.Value = "Monday" Then DayCell.Offset(, 2).Value = MonStartTime: DayCell.Offset(, 5).Value = MonFinishTime: GoTo nextDay
    If DayCell.Value = "Tuesday" Then DayCell.Offset(, 2).Value = MonStartTime: DayCell.Offset(, 5).Value = MonFinishTime: GoTo nextDay

nextDay:
Next

【讨论】：

感谢您花时间帮助我 Elio。这绝对是一个可行的解决方案。您是否在工作表中使用了命名单元格和范围？我也想尝试了解我的代码做错了什么。干杯

您所指的命名单元格和范围是什么！？我刚刚在For...Next 中添加了所需的更改。

我指的是上面的Sub ResetTimesheet() 代码。那就是说我只有下面的'For Each'代码，你是个天才！完美，非常感谢。

你可以检查一下我的帖子！ :-)

我试过了，但我需要 +15Rep 才能投票是否有帮助？无论如何，我会结束这个问题。为你的帮助干杯