VBA 计算百分比

VBA Calculate percentage

提问by user1701878

So i need some help. Im pretty new to VBA so im having some trouble. Well i have multiple sheets in my work book (excel). what im trying to do is, calculate the percentage of how many cells have the word "IMCOMPLETE" in column D and putting the outcome in the main sheet on a certain cell. Example:

所以我需要一些帮助。我对 VBA 很陌生，所以我遇到了一些麻烦。好吧，我的工作簿（excel）中有多个工作表。我想要做的是，计算 D 列中有多少单元格包含“IMCOMPLETE”一词，并将结果放在某个单元格的主表中。例子：

Sub Get_Percentage()

If Range("Hymanson,_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: I have like 10 sheet tabs. Not sure if this would be a macro.

仅供参考：我有 10 张标签。不确定这是否是一个宏。

回答by Jeremy Thompson

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

回答by Siddharth Rout

Here is a simple way to do it. I am doing it for one sheet. You can use it in a loop

这是一个简单的方法。我是为一张纸做的。您可以在循环中使用它

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

The above code can be also converted to a function which can be very useful when you are looping through the sheets.

上面的代码也可以转换为一个函数，这在您循环工作表时非常有用。

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