用于字符串搜索和调用 Sub 的 VBA 仅针对该相邻单元格

Question

我想根据程序找到字符串的位置创建一个逻辑范围。

sample Workbook

我正在尝试什么：

此示例工作簿将在每个工作表中包含一列日期和一列状态。每个工作表的“状态”列右侧还将有另一列，仅输出该日期的“当前”一词。 （如果这是多余的，并且您宁愿在显示所有日期的第一列中搜索当前日期，请随意忽略它。我只是为了简单起见。）

此程序需要在状态列右侧的列中搜索字符串“current”，然后复制并粘贴与其相邻的“状态”单元格值（或者只需通过行日期定位地址并运行如果您想忽略“当前”字符串的内容，则为该特定行的“状态”单元格添加子项）。 Sample 的状态单元格中不会有实际的公式，只有我输入的值以供参考，但原理相同。

Sub Ruby()
If Sheets("ALPHA").Range("T2:T5000").Value = "Current" Then
    Sheets("ALPHA").Select
    Call copy
End If
If Sheets("BRAVO").Range("T2:T5000").Value = "Current" Then
    Sheets("BRAVO").Select
    Call copy
End If
If Sheets("CHARLIE").Range("T2:T5000").Value = "Current" Then
    Sheets("CHARLIE").Select
    Call copy
End If
End Sub

Sub copy()
'
' copy Macro
'

'
Range("S98").Select
Selection.copy
Range("S98").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
End Sub

Answer 1

根据您的代码，您想将 S 列中的公式更改为一个值。

你可以遍历每张纸并让它发生

Sub RubyLoop()
    Dim sh As Worksheet, LstRw As Long
    Dim rng As Range, c As Range

    For Each sh In Sheets
        With sh
            LstRw = .Cells(.Rows.Count, "T").End(xlUp).Row
            Set rng = .Range("T2:T" & LstRw)

            For Each c In rng.Cells
                If c = "Current" Then c.Offset(, -1).Value = c.Offset(, -1).Value
            Next c
        End With
    Next sh


End Sub

如果结束

Sub RubyLoop2()
    Dim sh As Worksheet, LstRw As Long
    Dim rng As Range, c As Range

    For Each sh In Sheets
        With sh
            LstRw = .Cells(.Rows.Count, "T").End(xlUp).Row
            Set rng = .Range("T2:T" & LstRw)

            For Each c In rng.Cells
                If c = "Current" Then
                    c.Offset(, -1).Value = c.Offset(, -1).Value
                End If
            Next c
        End With
    Next sh


End Sub