2016-11-26 64 views
0

我有兩個子程序可以改變人名的佈局。第一個通過查找First和Last Name之間的空格「」將First Name更改爲Last Name,First Name。如何將兩個相似的子程序結合在一起

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過程查找一個逗號「」這兩個名字之間(例如:姓,名),並翻轉回名字姓氏順序。

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(也許別的東西嗎?),以測試空格或逗號來選擇要運行的代碼的一部分之一。謝謝,我期待看到您的想法。

+0

下面的答案是否適合您的問題?如果是這樣,我建議標記答案之一作爲接受關閉你的問題。 – zedfoxus

回答

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 

當有需要添加更多的功能

  • 添加枚舉常數以指示樣是需要
  • 添加代碼,以分割的數據格式的
  • 添加代碼以重新加入data

此外,您可以添加測試用例以確保此函數能夠滿足dif不同的傳入數據。您可以編寫測試,像這樣:

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 
0

下面是一些代碼,將翻轉的名稱(包括任何中間名)

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 
相關問題