VBA 백분율을 계산하십시오.

Question

그래서 도움이 필요합니다. 임 꽤 VBA에 새로운 몇 가지 문제가 있습니다. 글쎄, 필자는 내 작업서 (엑셀)에 여러 장의 시트를 가지고있다. 내가 무엇을하려고하는지는 열 D에 "IMCOMPLETE"라는 단어가있는 셀의 수를 계산하고 그 결과를 특정 셀의 주 시트에 넣는 것입니다. 예 :

Sub Get_Percentage() 

If Range("Jackson,_Mr._Vince_R.TrainingSt'!D2:D100").Value = "IMCOMPLETE" Then 
    put outcome in "TotalSummery%"!E2 
If Range("Carter,_Mr._Oscar_R_(Oscar)Trai'!D2:D100").Value = "IMCOMPLETE" Then 
    put outcome in "TotalSummery%"!E4 
If Range("Taravella,_Mr._Jim_(Jim)Trainin'!D2:D100") Value = "IMCOMPLETE" Then 
    put outcome in "TotalSummery%"!E5 

End Sub 

FYI : 나는 10 개의 시트 탭을 가지고 있습니다. 이것이 매크로인지 확실하지 않습니다.

Answer 1

Sub FindAndCountWordInExcelWorkBook(Byval SearchString As String) 

SearchString = "IMCOMPLETE" 

Dim oRange As Range, aCell As Range, bCell As Range 
    Dim ws As Worksheet 
    Dim ExitLoop As Boolean 
    Dim FoundAt As String 
    On Error GoTo Err 
    Dim i As Integer 
    For i = 1 To Worksheets.Count 

     Set ws = Worksheets(i) 
     Set oRange = ws.UsedRange 

     Dim CountOfKeyWord As Integer 

     Set aCell = oRange.Find(What:=SearchString, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) 
     If Not aCell Is Nothing Then 
      Set bCell = aCell 
      FoundAt = aCell.Address 
      Do While ExitLoop = False 
       Set aCell = oRange.FindNext(After:=aCell) 

       If Not aCell Is Nothing Then 
        If aCell.Address = bCell.Address Then Exit Do 
        CountOfKeyWord = CountOfKeyWord + 1 
        FoundAt = FoundAt & ", " & aCell.Address 
       Else 
        ExitLoop = True 
       End If 
      Loop 
     Else 
      ' MsgBox SearchString & " not Found" 
     End If 

    Next i 

    MsgBox "The Search String: " & SearchString & ", appeared " & CountOfKeyWord & " times at these locations: " & FoundAt 
    Exit Sub 
Err: 
    MsgBox Err.Description 
End Sub 

Answer 2

다음은 간단한 방법입니다. 나는 그것을 한 장씩하고있다. 루프에서 사용할 수 있습니다.

Sub Sample() 
    Dim ws As Worksheet 
    Dim SearchText As String 
    Dim WordCount As Long, ColDTotalWordCount As Long 
    Dim PercentageWord As Double 

    Set ws = ThisWorkbook.Sheets("Sheet1") 

    SearchText = "IMCOMPLETE" 

    With ws 
     '~~> Count the occurances of the word "IMCOMPLETE" 
     WordCount = Application.WorksheetFunction.CountIf(.Columns(4), SearchText) 

     '~~> Count the total words in Col D 
     ColDTotalWordCount = Application.WorksheetFunction.CountA(.Columns(4)) 

     '~~> Calculate Percentage 
     PercentageWord = WordCount/ColDTotalWordCount 
     Debug.Print Format(PercentageWord, "00.00%") 
    End With 
End Sub 

위의 코드는 시트를 반복 할 때 매우 유용 할 수있는 함수로 변환 될 수도 있습니다.

Option Explicit 

Sub Sample() 
    Dim wSheet As Worksheet 
    Dim TextToSearch As String 

    Set wSheet = ThisWorkbook.Sheets("Sheet1") 

    TextToSearch = "IMCOMPLETE" 

    Debug.Print GetPercentage(wSheet, TextToSearch) 
End Sub 

Function GetPercentage(ws As Worksheet, SearchText As String) As String 
    Dim WordCount As Long, ColDTotalWordCount As Long 
    Dim PercentageWord As Double 

    With ws 
     '~~> Count the occurances of the word "IMCOMPLETE" 
     WordCount = Application.WorksheetFunction.CountIf(.Columns(4), SearchText) 

     '~~> Count the total words in Col D 
     ColDTotalWordCount = Application.WorksheetFunction.CountA(.Columns(4)) 

     '~~> Calculate Percentage 
     PercentageWord = WordCount/ColDTotalWordCount 
     GetPercentage = Format(PercentageWord, "00.00%") 
    End With 
End Function