从计算中排除标题
下面的代码有一个计算问题。
该计算可以找出每列填充的行的百分比。 但是，由于标题，当一个工作表在列中没有值，但有标题显示为50％，这是不正确的。 有没有办法改变这个，所以它不包括在计算中的标题？ 这是最好的解决办法吗？
Sub Stackage() 'added function to skip corrupt files works! Adding skipped files works.. and do something about 50%. 'changed lrw to long, doesnt skip those files now :) Dim wb As Workbook, fileNames As Object, errCheck As Boolean 'part of loop Dim ws As Worksheet Dim resultSheet As Worksheet Dim i As Long Dim lco As Integer Dim lrw As Long Dim resultRow As Integer Dim measurement As Double 'To compile skipped files Dim wksSkipped As Worksheet Set wksSkipped = ThisWorkbook.Worksheets("Skipped") Set resultSheet = Application.ActiveSheet resultRow = 1 'Optimize Macro Speed Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual 'get user input for files to search Set fileNames = CreateObject("Scripting.Dictionary") errCheck = UserInput.FileDialogDictionary(fileNames) If errCheck Then Exit Sub For Each Key In fileNames 'loop through the dictionary On Error Resume Next Set wb = Workbooks.Open(fileNames(Key)) If Err.Number <> 0 Then Set wb = Nothing ' or set a boolean error flag End If On Error GoTo 0 ' or custom error handler If wb Is Nothing Then wksSkipped.Cells(wksSkipped.Cells(wksSkipped.Rows.Count, "A").End(xlUp).Row + 1, 1) = fileNames(Key) Else Debug.Print "Successfully loaded " & fileNames(Key) wb.Application.Visible = False 'make it not visible For Each ws In wb.Worksheets If Not Application.WorksheetFunction.CountA(ws.Cells) = 0 Then 'define the range to measure lco = ws.Cells.Find("*", , xlValues, xlWhole, xlByColumns, xlPrevious, False).Column lrw = ws.Columns("A:Y").Find("*", , xlValues, , xlRows, xlPrevious).Row If lrw = 1 Then lrw = 2 For i = 1 To lco measurement = Application.WorksheetFunction.CountA(ws.Range(ws.Cells(1, i), ws.Cells(lrw, i))) / lrw resultSheet.Cells(resultRow, 1).Value = wb.Name resultSheet.Cells(resultRow, 2).Value = ws.Name resultSheet.Cells(resultRow, 3).Value = ws.Cells(1, i).Value resultSheet.Cells(resultRow, 4).Style = "Percent" resultSheet.Cells(resultRow, 5).Value = measurement resultRow = resultRow + 1 Next End If Next wb.Application.Visible = True '' I added wb.Close savechanges:=False 'close the workbook do not save Set wb = Nothing 'release the object End If Next 'End of the fileNames loop Set fileNames = Nothing 'Message Box when tasks are completed MsgBox "Task Complete!" ResetSettings: 'Reset Macro Optimization Settings Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub Function Col_Letter(lngCol As Long) As String Dim vArr vArr = Split(Cells(1, lngCol).Address(True, False), "$") Col_Letter = vArr(0) End Function 对这一行做一个小小的改动：
measurement = Application.WorksheetFunction.CountA(ws.Range(ws.Cells(1, i), ws.Cells(lrw, i))) / lrw
将其更改为：
measurement = ws.Evaluate("sumproduct((" & ws.Range(ws.Cells(2, i), ws.Cells(lrw, i)).Address & "<>"""")+0)") / (lrw - 1)