vba Subroutine funktioniert auf einem Blatt, aber nicht eine andere

Question

Ich versuche, Namen auf zwei separaten Blättern "Alpha Roster" und "Paid" zu reinigen. Alpha Roster wird von anderen Personen aktualisiert und Paid ist mein Master-Tracker, wer bezahlt hat. Ich habe eine Funktion namens "MakeProper", die ziemlich gut funktioniert, wenn man Korrekturen in Alpha Roster vornimmt, aber aus irgendeinem Grund keine Korrekturen an Paid vornimmt. Beide Blätter sind gleich aufgebaut.

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 

Ich lese auf den Unterschied zwischen wählen und aktivieren. Wie Sie sehen können, versuche ich in CleanUpPaid ein paar verschiedene Möglichkeiten, um das kostenpflichtige Blatt zum aktiven Blatt zu machen, aber nichts scheint auf dem Blatt zu erscheinen, wie es in Alpha Roster der Fall ist.

Answer 1

Sie verarbeiten nur eine Zelle auf der Worksheets("Paid") und das ist Range("A2"). Sie können Set rngSrc = ActiveSheet.Range(ActiveWindow.Selection.Address) eleminieren und einfach Selection verwenden, es wird ein Bereichsobjekt zurückgegeben.

Angenommen, Sie möchten die Zellen in den Spalten A und G verarbeiten. Ich verwende meine Funktion TitleCase, um die Groß-/Kleinschreibung zu korrigieren, aber Sie können MakeBetterProper ersetzen, wenn Sie möchten.

---

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 

---

Meine Antwort auf How to make every letter of word into caps but not for letter “of”, “and”, “it”, “for” ?. wird die Großschreibung für Sie korrigieren.

Ich habe Rules for Capitalization in Titles of Articles als Referenz verwendet, um eine Groß-/Kleinschreibung zu erstellen.

Function TitleCase verwendet WorksheetFunction.ProperCase, um den Text vorzuproccess. Aus diesem Grund setze ich eine Ausnahme für Kontraktionen ein, weil WorksheetFunction.ProperCase sie nicht richtig kapitalisiert.

Das erste Wort in jedem Satz und das erste Wort nach einem doppelten Anführungszeichen werden groß geschrieben. Interpunktionszeichen werden ebenfalls ordnungsgemäß behandelt.

---

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