Question

以下代码存在计算问题。

此计算会找出每列填充的行数百分比。但是由于标题，当工作表在列中没有值但有标题时显示为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

Answer 1

对此行进行一处小改动：

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)

从计算中排除标题

1 个答案: