Question

我试图写一个宏，如果有一个单词格式为＆＃34; TOTAL＆＃34;然后它会在它下面的单元格中输入一个破折号。例如：

enter image description here

在上面的例子中，我想在单元格F7中使用短划线（注意：可能有任意数量的列，因此它总是第7行但不总是第F列。）

我目前正在使用此代码，但它无效，我无法弄清楚原因。

Dim celltxt As String
Range("C6").Select
Selection.End(xlToRight).Select
celltxt = Selection.Text
If InStr(1, celltext, "TOTAL") > 0 Then
Range("C7").Select
Selection.End(xlToRight).Select
Selection.Value = "-"
End If

帮助将不胜感激。希望我没有做一些愚蠢的事情。

Answer 1

这将遍历您定义("RANGE TO SEARCH")的给定范围内的所有单元格，并使用Offset()方法在下面的单元格中添加短划线。作为VBA的最佳实践，您绝不能使用Select方法。

Sub AddDashes()

Dim SrchRng As Range, cel As Range

Set SrchRng = Range("RANGE TO SEARCH")

For Each cel In SrchRng
    If InStr(1, cel.Value, "TOTAL") > 0 Then
        cel.Offset(1, 0).Value = "-"
    End If
Next cel

End Sub

Answer 2

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

If Not Intersect(Target, Range("C6:ZZ6")) Is Nothing Then

    If InStr(UCase(Target.Value), "TOTAL") > 0 Then
        Target.Offset(1, 0) = "-"
    End If

End If

End Sub

这将允许您动态添加列，并在包含不区分大小写的＆＃34; Total＆＃34;之后自动在C行中的任何列下面插入一个破折号。注意：如果您经过ZZ6，则需要更改代码，但这应该可以让您到达目的地。

Answer 3

这样做与CONTAINS一起增强：

Function SingleCellExtract(LookupValue As String, LookupRange As Range, ColumnNumber As Integer, Char As String)
Dim I As Long
Dim xRet As String
For I = 1 To LookupRange.Columns(1).Cells.Count
     If InStr(1, LookupRange.Cells(I, 1), LookupValue) > 0 Then
        If xRet = "" Then
            xRet = LookupRange.Cells(I, ColumnNumber) & Char
        Else
            xRet = xRet & "" & LookupRange.Cells(I, ColumnNumber) & Char
        End If
    End If
Next
SingleCellExtract = Left(xRet, Len(xRet) - 1)
End Function

Answer 4

Dim celltxt As String
Range("C6").Select
Selection.End(xlToRight).Select
celltxt = Selection.Text
If InStr(1, celltext, "TOTAL") > 0 Then
Range("C7").Select 
Selection.End(xlToRight).Select
Selection.Value = "-"
End If

您在指令中声明了“ celltxt”并使用了“ celltext”。

Answer 5

这是你在找什么？

 If ActiveCell.Value == "Total" Then

    ActiveCell.offset(1,0).Value = "-"

 End If

你可以做这样的事情

 Dim celltxt As String
 celltxt = ActiveSheet.Range("C6").Text
 If InStr(1, celltxt, "Total") Then
    ActiveCell.offset(1,0).Value = "-"
 End If

这与你的相似。

Answer 6

要求：
找到包含单词TOTAL的单元格，然后在其下面的单元格中输入破折号。

解决方案： 此解决方案使用Find对象的Range方法，因为似乎使用它而不是蛮力（For…Next循环）似乎是合适的。有关该方法的说明和详细信息，请参见Range.Find method (Excel)

实施方式：
为了提供灵活性，Find方法被包装在此函数中：

Function Range_ƒFind_Action(sWhat As String, rTrg As Range) As Boolean

位置：
sWhat：包含string进行搜索
rTrg：是要搜索的range

如果找到匹配项，则该函数返回True，否则返回False

此外，每次函数找到匹配项时，它将结果range传递到过程Range_Find_Action以执行所需的操作，（即“在其下面的单元格中输入破折号” ）。 “必需的操作” 在单独的过程中，以实现自定义和灵活性。

该函数的调用方式：

该测试正在搜索“总计”以显示MatchCase:=False的效果。通过将匹配项更改为MatchCase:=True

，可以使其区分大小写

Sub Range_Find_Action_TEST()
Dim sWhat As String, rTrg As Range
Dim sMsgbdy As String
    sWhat = "total"                                             'String to search for (update as required)
    Rem Set rTrg = ThisWorkbook.Worksheets("Sht(0)").UsedRange  'Range to Search (use this to search all used cells)
    Set rTrg = ThisWorkbook.Worksheets("Sht(0)").Rows(6)        'Range to Search (update as required)
    sMsgbdy = IIf(Range_ƒFind_Action(sWhat, rTrg), _
        "Cells found were updated successfully", _
        "No cells were found.")
    MsgBox sMsgbdy, vbInformation, "Range_ƒFind_Action"
    End Sub

这是查找函数

Function Range_ƒFind_Action(sWhat As String, rTrg As Range) As Boolean
Dim rCll As Range, s1st As String
    With rTrg

        Rem Set First Cell Found
        Set rCll = .Find(What:=sWhat, After:=.Cells(1), _
            LookIn:=xlFormulas, LookAt:=xlPart, _
            SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)

        Rem Validate First Cell
        If rCll Is Nothing Then Exit Function
        s1st = rCll.Address

        Rem Perform Action
        Call Range_Find_Action(rCll)

        Do
            Rem Find Other Cells
            Set rCll = .FindNext(After:=rCll)
            Rem Validate Cell vs 1st Cell
            If rCll.Address <> s1st Then Call Range_Find_Action(rCll)

        Loop Until rCll.Address = s1st

    End With

    Rem Set Results
    Range_ƒFind_Action = True

    End Function

这是 Action 过程

Sub Range_Find_Action(rCll)
    rCll.Offset(1).Value2 = Chr(167)    'Update as required - Using `§` instead of "-" for visibilty purposes
    End Sub

使用＆＃34;如果单元格包含＆＃34;在VBA excel

6 个答案: