vba 서브 루틴은 시트 하나에서 작동하지만 다른 시트에서는 작동하지 않습니다.

Question

"Alpha Roster"와 "Paid"두 개의 별도 시트에서 이름을 정리하려고합니다. 알파 로스터 (Alpha Roster)는 다른 사람들에 의해 업데이트되며 유료는 누가 돈을 지불했는지에 대한 마스터 트래커입니다. 나는 알파 로스터 (Alpha Roster)에 대한 수정 작업에 상당히 잘 작동하는 "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 

선택과 활성화의 차이점에 대해 읽었습니다. 보시다시피, CleanUpPaid에서 나는 유료 시트를 활성 시트로 만드는 두 가지 방법을 시도하지만 Alpha Roster 에서처럼 시트에 아무 것도 나타나지 않습니다.

Answer 1

Worksheets("Paid")에 하나의 셀만 처리 중이고 Range("A2")입니다. Set rngSrc = ActiveSheet.Range(ActiveWindow.Selection.Address)을 제거하고 Selection을 사용하면 범위 객체가 반환됩니다.

열 A와 G의 셀을 처리한다고 가정합니다. TitleCase의 대문자를 수정하려면 내 함수 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