Question

所以我需要一些帮助。我对VBA很新，所以我遇到了一些麻烦。好吧，我的工作簿中有多张表（excel）。我想要做的是，计算在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

仅供参考：我喜欢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

VBA计算百分比

2 个答案: