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

时间:2016-01-29 17:37:02

标签: vba excel-vba excel

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

sample Workbook

我在尝试什么:

此示例工作簿将包含一列日期和每个工作表的一列状态。每个工作表还将在“状态”列右侧显示​​另一列,该列仅输出该日期的“当前”一词。 (如果这是多余的,你宁愿在显示所有日期的第一列中搜索当前日期,请随意忽略这一点。我只是把它放进去让我变得简单。)

此程序需要在状态列右侧的列中搜索字符串“current”,并将“status”单元格值复制并粘贴到它旁边(或者只是通过行日期找到地址并运行如果要忽略“当前”字符串,则为该特定行的“状态”单元格的子项。 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

1 个答案:

答案 0 :(得分:2)

从您的代码看起来,您希望将列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