如果(isnumber(搜索)vba

问题描述 投票:0回答:2

我有下表:

┌────────────────────────────────┬──┬──┬──┬──┬──┬──┬──┬─────┬──┬──┬──┬───┐
│               I                │  │  │  │  │  │  │  │   L │  │  │  │ S │
├────────────────────────────────┼──┼──┼──┼──┼──┼──┼──┼─────┼──┼──┼──┼───┤
│                                │  │  │  │  │  │  │  │     │  │  │  │   │
│ Mr John Smith                  │  │  │  │  │  │  │  │     │  │  │  │   │
│ Mr Jack Paul and Mrs Jack Paul │  │  │  │  │  │  │  │     │  │  │  │   │
└────────────────────────────────┴──┴──┴──┴──┴──┴──┴──┴─────┴──┴──┴──┴───┘

我的VBA代码是:

Sub x()
    Dim TR As Long
    TR = Cells(Rows.Count, "I").End(xlUp).Row
    Range("L2:L" & TR) = Evaluate("IF(ISNUMBER(SEARCH(""MR"",I2:I" & TR & ")),""Dear Sir"","""")")
    Dim SS As Long
    SS = Cells(Rows.Count, "L").End(xlUp).Row
    Range("S2:S" & SS) = Evaluate("IF(ISNUMBER(SEARCH(""Dear Sir"",L2:L" & SS & ")),""your banking facility"","""")")
End Sub

我想要的是:

如果在列IMrMrs然后列L= Dear Sir/Madam,如果L= Dear Sir/Madam然后列S= your banking facilities

先生的作品很好。

excel vba
2个回答
0
投票

2个版本

版本1根据您更新的注释 - 使用指定格式的循环表。

版本2您可以使用字典和搜索词

版本1

循环表的结构以及客户搜索项是否有所不同(由ElseIfs涵盖)

目前设置循环2张。我已经设定了:

  1. custNameColumn:预期客户名称列= A.
  2. salutationColumn预期称呼栏= 2(“B”)
  3. commentColumn预计银行业评论栏= 3(“C”)
  4. targetFirstRow第一个客户名称= 2的每张表中的行

这些可以在代码中更改,但必须在工作表之间保持一致。

它不是最有效的方法,但您无法使用当前设置的Evaluate方法,因此这是一个简单的替代方法,而不是进入更复杂的代码。

您可以为更多搜索字词添加其他ElseIf语句,例如Master

您可以向sheetsArr添加更多工作表

Option Explicit

  Sub test()

        Dim wb As Workbook
        Dim wsTarget As Worksheet
        Dim targetRange As Range

        Set wb = ThisWorkbook

        Dim sheetsArr()
        sheetsArr = Array("Sheet1", "Sheet2")

        Const custNameColumn As String = "A" 'column where customer name is
        Const salutationColumn As Long = 2 'column where "Dear" goes
        Const commentColumn As Long = 3 'column where "Banking goes"
        Const targetFirstRow As Long = 2 'row where first customer name is

        Dim targetLastRow As Long
        Dim currentSheet As Long

        For currentSheet = LBound(sheetsArr) To UBound(sheetsArr)
          '  On Error Resume Next
            Set wsTarget = wb.Worksheets(sheetsArr(currentSheet))
          '  On Error GoTo 0
            targetLastRow = wsTarget.Cells(Rows.Count, custNameColumn).End(xlUp).Row

            Set targetRange = wsTarget.Range(custNameColumn & targetFirstRow & ":" & custNameColumn & targetLastRow)

            Dim currentCell As Range

            For Each currentCell In targetRange

                If InStr(1, LCase$(currentCell), "mr ", vbBinaryCompare) > 0 And _
                    InStr(1, LCase$(currentCell), "mrs ", vbBinaryCompare) > 0 Then

                    currentCell.Offset(, salutationColumn - 1) = "Dear Sir/Madame"
                    currentCell.Offset(, commentColumn - 1) = "Banking Facilities"

                ElseIf InStr(1, LCase$(currentCell), "mr and mr", vbBinaryCompare) > 0 Then

                    currentCell.Offset(, salutationColumn - 1) = "Dear Mssrs"
                    currentCell.Offset(, commentColumn - 1) = "Banking Facilities"

                ElseIf InStr(1, LCase$(currentCell), "mrs ", vbBinaryCompare) > 0 Then

                     currentCell.Offset(, salutationColumn - 1) = "Dear Madame"
                     currentCell.Offset(, commentColumn - 1) = "Banking Facility"

                ElseIf InStr(1, LCase$(currentCell), "mr ", vbBinaryCompare) > 0 Then

                     currentCell.Offset(, salutationColumn - 1) = "Dear Sir"
                     currentCell.Offset(, commentColumn - 1) = "Banking Facility"

                ElseIf InStr(1, LCase$(currentCell), "miss ", vbBinaryCompare) > 0 Then

                     currentCell.Offset(, salutationColumn - 1) = "Dear Miss"
                     currentCell.Offset(, commentColumn - 1) = "Banking Facility"
                End If

            Next currentCell

        Next currentSheet

    End Sub

版本2:

所以你可以把searchTerm放在一个变量中。注意我使用字典来保存标题和相关的称呼。您可以为新项目扩展此字典。

如果您有多个不同的搜索字词,我不确定以这种方式使用的评估是正确的方法。

要以这种方式使用Evaluate,你需要相等长度的范围,这样你就可以取消SS并只使用TR

Option Explicit

Sub x()

    With ActiveSheet

    Dim TR As Long
    TR = .Cells(Rows.Count, "I").End(xlUp).Row

    Dim searchTerm As String

    searchTerm = "Mr and Mr"

    Dim salutationDictionary As Object

    Set salutationDictionary = CreateObject("Scripting.Dictionary")

    salutationDictionary.Add "Mr", "Dear Sir"
    salutationDictionary.Add "Mrs", "Dear Madame"
    salutationDictionary.Add "Ms", "Dear Miss"
    salutationDictionary.Add "Mr and Mr", "Mssrs" 'keep adding here

    Dim bankingComment As String

    Select Case searchTerm

    Case "Mr", "Mrs", "Ms"  ' - singular cases add here
       bankingComment = "your banking facility"
    Case Else
        bankingComment = "your banking facilities"
    End Select

    .Range("L2:L" & TR) = Evaluate("IF(ISNUMBER(SEARCH(""" & searchTerm & """,I2:I" & TR & ")),""" & salutationDictionary(searchTerm) & ""","""")")
    .Range("S2:S" & TR) = Evaluate("IF(ISNUMBER(SEARCH(""" & salutationDictionary(searchTerm) & """,L2:L" & TR & ")),""" & bankingComment & ""","""")")


    End With

End Sub

0
投票

也许你就是在这之后

Sub x()
    Dim TR As Long
    TR = Cells(Rows.Count, "I").End(xlUp).Row
    Range("L2:L" & TR) = Evaluate("IF(ISNUMBER(SEARCH(""MR"",I2:I" & TR & ")),""Dear Sir"","""")")
    Range("L2:L" & TR) = Evaluate("IF(AND(ISNUMBER(SEARCH(""MR "",I2:I" & TR & ")),ISNUMBER(SEARCH(""MRS"",I2:I" & TR & "))),""Dear Sir/Madam"","""")")
    Dim SS As Long
    SS = Cells(Rows.Count, "L").End(xlUp).Row
    Range("S2:S" & SS) = Evaluate("IF(ISNUMBER(SEARCH(""Dear Sir"",L2:L" & SS & ")),""your banking facility"","""")")
    Range("S2:S" & SS) = Evaluate("IF(ISNUMBER(SEARCH(""Dear Sir/Madam"",L2:L" & SS & ")),""your banking facilities"","""")")
End Sub
© www.soinside.com 2019 - 2024. All rights reserved.