vba子程序在一張紙上工作，但不是另一張

Question

我試圖在兩張單獨的紙張「Alpha名冊」和「付費」上清除名字。阿爾法花名冊由其他人更新，付費是我支付的主要追蹤者。我有一個名爲「MakeProper」的功能，可以很好地糾正阿爾法花名冊上的錯誤，但由於某些原因不會對賠付進行任何更正。兩張紙都設置相同。

Sub CleanUpPaid() 

    Sheets("Paid").Activate 
    Sheets("Paid").Select 
    Range("A2").Select 
    MakeProper 

End Sub 

Sub MakeProper() 
    Dim rngSrc As Range 
    Dim lMax As Long, lCtr As Long 

    Set rngSrc = ActiveSheet.Range(ActiveWindow.Selection.Address) 
    lMax = rngSrc.Cells.Count 

    ' clean up Sponsor's Names 
    For lCtr = 3 To lMax 
    If Not rngSrc.Cells(lCtr, 1).HasFormula And _ 
      rngSrc.Cells(lCtr, 1) <> "CMC" Then 
     rngSrc.Cells(lCtr, 1) = MakeBetterProper(rngSrc.Cells(lCtr, 1)) 
    End If 

    ' clean up Guest's Names 
    If Not rngSrc.Cells(lCtr, 7).HasFormula Then 
     rngSrc.Cells(lCtr, 7) = MakeBetterProper(rngSrc.Cells(lCtr, 7)) 
    End If 

    Next lCtr 
    'MsgBox ("Make Proper " & ActiveSheet.Name) 
End Sub 

Function MakeBetterProper(ByVal ref As Range) As String 
    Dim vaArray As Variant 
    Dim c As String 
    Dim i As Integer 
    Dim J As Integer 
    Dim vaLCase As Variant 
    Dim str As String 

    ' Array contains terms that should be lower case 
    vaLCase = Array("CMC", "II", "II,", "III", "III,") 

    ref.Replace what:=",", Replacement:=", " 
    ref.Replace what:=", ", Replacement:=", " 
    ref.Replace what:="-", Replacement:=" - " 
    c = StrConv(ref, 3) 

    'split the words into an array 
    vaArray = Split(c, " ") 

    For i = (LBound(vaArray) + 1) To UBound(vaArray) 
    For J = LBound(vaLCase) To UBound(vaLCase) 
     ' compare each word in the cell against the 
     ' list of words to remain lowercase. If the 
     ' Upper versions match then replace the 
     ' cell word with the lowercase version. 
     If UCase(vaArray(i)) = UCase(vaLCase(J)) Then 
      vaArray(i) = vaLCase(J) 
     End If 
    Next J 
    Next i 

' rebuild the sentence 
    str = "" 
    For i = LBound(vaArray) To UBound(vaArray) 
    str = str & " " & vaArray(i) 
    str = Replace(str, " - ", "-") 
    str = Replace(str, "J'q", "J'Q") 
    str = Replace(str, "Jr", "Jr.") 
    str = Replace(str, "Jr..", "Jr.") 
    str = Replace(str, "(Jr.)", "Jr.") 
    str = Replace(str, "Sr", "Sr.") 
    str = Replace(str, "Sr..", "Sr.") 
    Next i 

    MakeBetterProper = Trim(str) 

End Function 

我讀了關於select和activate的區別。正如你所看到的，在CleanUpPaid中，我嘗試了幾種不同的方式來使付費表成爲活動工作表，但在工作表中似乎沒有任何事情發生，就像在Alpha Roster中一樣。

Answer 1

您只處理Worksheets("Paid")上的一個單元格，即Range("A2")。您可以清除Set rngSrc = ActiveSheet.Range(ActiveWindow.Selection.Address)，並使用Selection它返回一個範圍對象。

假設您想要處理列A和G中的單元格，我正在使用函數TitleCase來更正大小寫，但是如果願意，您可以用MakeBetterProper來代替。

---

Sub FixNames() 
    Application.ScreenUpdating = False 

    Dim ws As Worksheet 
    Dim c As Range 

    For Each ws In Worksheets(Array("Alpha Roster", "Paid")) 
     With ws 
      For Each c In Intersect(.Columns(1), .UsedRange) 

       If Not c.HasFormula And c.Value <> "CMC" Then c.Value = TitleCase(c.text) 

      Next 

      For Each c In Intersect(.Columns(7), .UsedRange) 

       If Not c.HasFormula Then c.Value = TitleCase(c.text) 

      Next 

     End With 

    Next 

    Application.ScreenUpdating = True 
End Sub 

---

我的回答How to make every letter of word into caps but not for letter 「of」, 「and」, 「it」, 「for」 ?.會糾正你的資本。

我用Rules for Capitalization in Titles of Articles作爲創建大寫異常列表的參考。

Function TitleCase使用WorksheetFunction.ProperCase預處理文本。出於這個原因，我對收縮進行了例外，因爲WorksheetFunction.ProperCase不恰當地利用它們。

每個句子的第一個單詞和雙引號之後的第一個單詞將保持大寫。標點符號也可以正確處理。

---

Function TitleCase(text As String) As String 
    Dim doc 
    Dim sentence, word, w 
    Dim i As Long, j As Integer 
    Dim arrLowerCaseWords 

    arrLowerCaseWords = Array("a", "an", "and", "as", "at", "but", "by", "for", "in", "of", "on", "or", "the", "to", "up", "nor", "it", "am", "is") 

    text = WorksheetFunction.Proper(text) 

    Set doc = CreateObject("Word.Document") 
    doc.Range.text = text 

    For Each sentence In doc.Sentences 
     For i = 2 To sentence.Words.Count 
      If sentence.Words.Item(i - 1) <> """" Then 
       Set w = sentence.Words.Item(i) 
       For Each word In arrLowerCaseWords 
        If LCase(Trim(w)) = word Then 
         w.text = LCase(w.text) 
        End If 

        j = InStr(w.text, "'") 

        If j Then w.text = Left(w.text, j) & LCase(Right(w.text, Len(w.text) - j)) 

       Next 
      End If 
     Next 
    Next 

    TitleCase = doc.Range.text 

    doc.Close False 
    Set doc = Nothing 
End Function