VBA计算百分比

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