Question

我有两个子程序可以改变一个人姓名的布局。第一个将名字改为姓氏，名字通过查找空格＆＃34; ＆＃34;在名字和姓氏之间。

Sub FlipNames()  'FN LN to LN, FN
'Purpose: Converts selected cells First Name Last Name in place to Last Name, First Name

    Dim x As Integer
    Dim sCell As String
    Dim sLast As String
    Dim sFirst As String
    Dim rCell As Range

    For Each rCell In Selection     'sets range to selection
        sCell = rCell.Value
        x = InStr(sCell, " ")       'searches for space
        If x > 0 Then               'flips order
            sFirst = Left(sCell, x - 1)
            sLast = Mid(sCell, x + 1)
            rCell.Value = sLast & ", " & sFirst 'places comma in between LN, FN
        End If
    Next
    Set rCell = Nothing             'resets the range to zero
End Sub

第二个sup程序查找逗号＆＃34;，＆＃34;在两个名字之间（例如：姓氏，名字）并将其翻转回名字姓氏顺序。

Sub FlipNames2()  'LN, FN to FN LN
'Purpose: Converts selected cells Last Name, First Name in place to First Name Last Name

    Dim x As Integer
    Dim sCell As String
    Dim sLast As String
    Dim sFirst As String
    Dim rCell As Range

    For Each rCell In Selection     'sets range to selection
        sCell = rCell.Value
        x = InStr(sCell, ",")       'searches for comma
        If x > 0 Then               'flips order
            sFirst = Left(sCell, x - 1)
            sLast = Mid(sCell, x + 1)
            rCell.Value = sLast & " " & sFirst 'places space in between FN LN
            rCell.Value = LTrim(rCell)         'trims off leading spaces
        End If
    Next
    Set rCell = Nothing             'resets the range to zero
End Sub

我想要帮助的是将这两个单独的子程序合并为一个使用If Else（可能是别的？）来测试空格或逗号以选择要运行的代码的哪个部分。谢谢，我期待看到你的想法。

Answer 1

你似乎正在思考正确的路线。重构可能是个好主意，因为方法非常相似。试试这个：

' FlipMethod cases handled:
'  If "FN LN to LN, FN" is supplied: John Smith will be converted to Smith, John
'  If "LN, FN to FN LN" is supplied: Smith, John will be converted to John Smith
Sub FlipNames(FlipMethod as String)  'FN LN to LN, FN
'Purpose: Converts selected cells First Name Last Name in place to Last Name, First Name

    Dim x As Integer
    Dim sCell As String
    Dim sLast As String
    Dim sFirst As String
    Dim rCell As Range

    For Each rCell In Selection     'sets range to selection
        sCell = rCell.Value

        if FlipMethod = "FN LN to LN, FN" then
            x = InStr(sCell, " ")       'searches for space
        else
            x = Instr(sCell, ",")       ' searches for comma
        end if

        If x > 0 Then               'flips order
            sFirst = Left(sCell, x - 1)
            sLast = Mid(sCell, x + 1)

            if FlipMethod = "FN LN to LN, FN" then
                rCell.Value = sLast & ", " & sFirst 'places comma in between LN, FN
            else
                rCell.Value = sLast & " " & sFirst 'places space in between FN LN
                rCell.Value = LTrim(rCell)         'trims off leading spaces
            end if

        End If
    Next
    Set rCell = Nothing             'resets the range to zero
End Sub

在多个单元格中分隔名称格式和迭代的功能可能有一些价值。以下是与迭代分离的功能示例。

Enum NameFormat
    FNLN_TO_LNFN_WITH_COMMA = 1
    LNFN_WITH_COMMA_TO_FNLN = 2
End Enum

Function FlipNames(Data As String, NameFormat As Long) As String

    Dim x As Integer
    Dim sLast As String
    Dim sFirst As String

    ' Exit early if data is improper
    If IsNull(Data) Or Len(Trim(Data)) = 0 Then
        FlipNames = Data
        Exit Function
    End If

    ' Check if comma or space is present, depending on requirements
    Select Case (NameFormat)
        Case FNLN_TO_LNFN_WITH_COMMA
            x = InStr(Data, " ")
        Case LNFN_WITH_COMMA_TO_FNLN
            x = InStr(Data, ",")
        Case Else
            FlipNames = Data
            Exit Function
    End Select

    ' Exit early if required split character not found
    If x <= 0 Then
        FlipNames = Data
        Exit Function
    End If

    ' Find first and last names
    sFirst = Trim(Left(Data, x - 1))
    sLast = Trim(Mid(Data, x + 1))

    ' Put data together as desired
    Select Case NameFormat
        Case FNLN_TO_LNFN_WITH_COMMA
            FlipNames = sLast & ", " & sFirst
        Case LNFN_WITH_COMMA_TO_FNLN
            FlipNames = Trim(sLast & " " & sFirst)
    End Select

End Function

当需要添加更多功能时

添加枚举常量以指示所需的格式类型
添加代码以拆分数据
添加代码以重新加入数据

此外，您可以添加测试用例以确保此功能能够满足不同传入数据的需要。您可以编写如下测试：

Sub Test_FlipNames()
    Dim TestCase As String
    Dim ExpectedResult As String
    Dim Result As String

    TestCase = "John Smith"
    ExpectedResult = "Smith, John"
    Result = FlipNames(TestCase, NameFormat.FNLN_TO_LNFN_WITH_COMMA)
    Test_PrintResults TestCase, ExpectedResult, Result

    TestCase = "John Smith"
    ExpectedResult = TestCase
    Result = FlipNames(TestCase, 1000)
    Test_PrintResults TestCase, ExpectedResult, Result

    TestCase = "Smith, John"
    ExpectedResult = "John Smith"
    Result = FlipNames(TestCase, NameFormat.LNFN_WITH_COMMA_TO_FNLN)
    Test_PrintResults TestCase, ExpectedResult, Result

    TestCase = "Smith, John"
    ExpectedResult = TestCase
    Result = FlipNames(TestCase, 1000)
    Test_PrintResults TestCase, ExpectedResult, Result

    TestCase = "John"
    ExpectedResult = "John"
    Result = FlipNames(TestCase, NameFormat.FNLN_TO_LNFN_WITH_COMMA)
    Test_PrintResults TestCase, ExpectedResult, Result

    TestCase = "John"
    ExpectedResult = "John"
    Result = FlipNames(TestCase, NameFormat.LNFN_WITH_COMMA_TO_FNLN)
    Test_PrintResults TestCase, ExpectedResult, Result

End Sub

Sub Test_PrintResults(TestCase As String, ExpectedResult As String, Result As String)
    Debug.Print "Case: " & TestCase & "; Expected: " & ExpectedResult
    Debug.Print IIf(Result = ExpectedResult, "PASS", "FAILED")
End Sub

此类测试的优点是，如果功能发生变化，可以运行现有测试以确保先前的功能没有中断。然后添加更多测试以检查添加的其他代码是否正常。

要在一系列单元格中调用该函数，您可以按照它的方式执行：

Sub FlipNamesInSelection()
    Dim rCell as Range
    For Each rCell in Selection
        rCell.Value = FlipNames(rCell.Value, NameFormat.LNFN_WITH_COMMA_TO_FNLN)
    Next
End Sub

Answer 2

以下是一些将翻转名称（包括任何中间名称）的代码

Sub TestFlipName()
    Debug.Print FlipName("First Middle Last")
    Debug.Print FlipName("Last, First")
End Sub

Function FlipName(sName As String) As String

    Dim i As Long
    Dim NameArray() As String: NameArray = Split(Replace(sName, ",", ""))

    If InStr(sName, ",") Then
        For i = 1 To UBound(NameArray)
            FlipName = FlipName + NameArray(i) + " "
        Next i
        FlipName = FlipName + NameArray(0)
    Else
        FlipName = NameArray(UBound(NameArray)) + ", "
        For i = 1 To UBound(NameArray)
            FlipName = FlipName + NameArray(i - 1) + " "
        Next i
        FlipName = Trim(FlipName)
    End If
End Function

如何将两个类似的子程序组合在一起

2 个答案: