简单项目计数VBA功能

时间:2014-04-17 14:43:39

标签: excel-vba vba excel

假设我们有一个“帐号”标题,其中列出了多个帐号,它们之间有2-3个空格。

对于此标头的每个实例,我希望能够计算下面非空单元格的数量,并在一行中空白单元格的数量大于或等于4时结束计数。每个计数都可以出现在现有工作表或新工作表中的A列中。

我已向此提出了类似的问题,并相信我在此处所述的方式简化了过程。唯一的问题是列中还有其他文本,因此为了计算实例“帐号”,需要首先找到该实例,迭代所有实例。

有没有人碰巧使用Excel VBA如何做到这一点?谢谢!电子表格的一个块如下所示:

Other Text 
Other Text
Other Text

Account Number

12345



23456


34567



45678


Other Text
Other Text

Account Number

在另一张纸上,输出实际上只是一列数字,例如:

4 'as in the example above
6
5
14
4
15

2 个答案:

答案 0 :(得分:1)

让我们看看这是否有效......我对帐号的标准进行了评论,但这里又是:(1)帐号是数字,(2)是5位数(即> 9999)

Option Explicit
Sub CaptureAccountNumbers()

'criteria for an account number:
'1. is numeric
'2. is 5-digits (i.e. > 9999)

Dim DataSheet As Worksheet, OutSheet As Worksheet
Dim LastRow As Long, TargetCol As Long, StartRow As Long, _
    Index As Long, CountOfAccountNumbers As Long, _
    ResultCounter As Long

'set variables for easy reference
Set DataSheet = ThisWorkbook.Worksheets("Sheet1")
Set OutSheet = Worksheets.Add
'delete any previously-existing "Results" worksheets
If DoesSheetExist("Results", ThisWorkbook) Then
    Application.DisplayAlerts = False
    ThisWorkbook.Worksheets("Results").Delete
    Application.DisplayAlerts = True
End If
OutSheet.Name = "Results"
TargetCol = 1 'i.e. column A
CountOfAccountNumbers = 0
StartRow = 0
ResultCounter = 1
LastRow = FindLastRowInCol(DataSheet, TargetCol)

'find the first occurence of "Account Number"
For Index = 1 To LastRow
    If DataSheet.Cells(Index, TargetCol) = "Account Number" Then
        StartRow = Index
        Exit For
    End If
Next Index

'loop through column A identifying account numbers
For Index = StartRow + 1 To LastRow
    If DataSheet.Cells(Index, TargetCol) = "Account Number" Then
        OutSheet.Cells(ResultCounter, TargetCol) = CountOfAccountNumbers
        CountOfAccountNumbers = 0
        ResultCounter = ResultCounter + 1
    Else
        If IsNumeric(DataSheet.Cells(Index, TargetCol)) And DataSheet.Cells(Index, TargetCol) > 9999 Then
            CountOfAccountNumbers = CountOfAccountNumbers + 1
        End If
    End If
Next Index

'write out the last account numbers if there are any
If CountOfAccountNumbers > 0 Then
    OutSheet.Cells(ResultCounter, TargetCol) = CountOfAccountNumbers
End If

End Sub

Public Function FindLastRowInCol(flricSheet As Worksheet, flricColumn As Long) As Long
    Dim LastRow As Long
    If flricColumn <> 0 Then
        With flricSheet
            LastRow = .Cells(.Rows.Count, flricColumn).End(xlUp).Row
        End With
    Else
        LastRow = 1
    End If
    FindLastRowInCol = LastRow
End Function

Public Function DoesSheetExist(dseWorksheetName As String, dseWorkbook As Workbook) As Boolean
    Dim obj As Object
    On Error Resume Next
    'if there is an error, sheet doesn't exist
    Set obj = dseWorkbook.Worksheets(dseWorksheetName)
    If Err = 0 Then
        DoesSheetExist = True
    Else
        DoesSheetExist = False
    End If
    On Error GoTo 0
End Function

答案 1 :(得分:0)

假设标题出现的列是B,您可以从这样的

开始
n = Worksheets("Sheet1").Range("B:B").Cells.SpecialCells(xlCellTypeConstants).Count-1

这将计算列中所有非空白单元格的常量(不是从公式派生的值)并减去1(对于标题)。然后,您可以使用

将值分配给单元格A1
Cells(1, 1).Value = n

如果您可以发布数据样本,因为它会显示在工作表上,以便将来有所帮助。