vba编程数据统计（如何用VBA统计同一工作簿中不同sheet同一列中不重复数据的个数并返回到一个新的sheet中，求完整代码）

本文目录

• 如何用VBA统计同一工作簿中不同sheet同一列中不重复数据的个数并返回到一个新的sheet中，求完整代码
• 表格中一某列连续数据的统计，求用VBA代码
• vba统计 统计数据的个数
• Excel VBA 按月统计数据
• 用VBA统计满足条件的数据的个数，求大神，
• excel vba 怎么对去重后的数据进行个数统计
• 利用VBA统计EXCEL中的数据
• 如何使用函数和VBA统计范围内的数值
• 关于EXCEL VBA编程做数据统计的请教！
• 利用Excel VBA统计一组数据的算法

如何用VBA统计同一工作簿中不同sheet同一列中不重复数据的个数并返回到一个新的sheet中，求完整代码

第2次按数据在Q列修改后的代码如下：
Sub 代码重写后2()Dim d, irow&, i&, j&, k&, m&, brr(1 To 200, 1 To 2)
Set d = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
For i = 1 To Sheets.Count
Application.DisplayAlerts = False
If Sheets(i).Name = "统计" Then Sheets(i).Delete
Application.DisplayAlerts = True
arr = Sheets(i).UsedRange
k = 0
irow = Sheets(i)..End(xlDown).Row + 2 ’取得q1向下第一个有数据的单元格的行号+2（标题行）
For j = irow To UBound(arr) ’假设标题行有2行
sr = arr(j, 11)’Q列
If Len(sr) Then
If Not d.exists(sr) Then
k = k + 1
d(sr) = k
End If
End If
Next j
m = m + 1
brr(m, 1) = Sheets(i).Name
brr(m, 2) = k
d.RemoveAll
Next i
Application.DisplayAlerts = False
ActiveWorkbook.Sheets.Add Before:=ActiveWorkbook.Worksheets(1)
Application.DisplayAlerts = True
With ActiveSheet
.Name = "统计"
. = "表格名称"
. = "不重复个数"
..Resize(UBound(brr, 1), UBound(brr, 2)) = brr
End With
d.RemoveAll
Application.ScreenUpdating = True
End Sub

表格中一某列连续数据的统计，求用VBA代码

Sub tj_test()

Dim lxZ As Integer

Dim hH As Long

Range(Cells(1, 2), Cells(1000, 2)).ClearContents

hH = 1: lxZ = 0

Do While Cells(hH, 1) 《》 ""

If Cells(hH, 1) = "爆1" Then

Cells(hH, 2) = lxZ: lxZ = 0

Else

lxZ = lxZ + 1

End If

hH = hH + 1

Loop

End Sub

运行结果如图：

vba统计 统计数据的个数

用鼠标选择一个区域,比如 a2:d10,然后运行代码
Sub test2()
Dim Arr1, Arr2
Dim i, j, k As Integer
Arr1 = Application.Selection
If Arr1 = "" Then
MsgBox "Please select data"
Exit Sub
End If
k = UBound(Arr1)
ReDim Arr2(1 To k, 1 To 2)
For i = 1 To k
For j = 1 To 4
If Arr1(i, j) 《 6 Then
Arr2(i, 1) = Arr2(i, 1) + 1
Else
Arr2(i, 2) = Arr2(i, 2) + 1
End If
Next j
Next i
Columns("f:g").Clear
i = Application.Selection.Row
Range(Cells(i, 6), Cells(i + k - 1, 7)) = Arr2
End Sub

Excel VBA 按月统计数据

工作表的change事件：

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target = Range("h3") Or Target = Range("i2") Then

        Dim i As Integer

        For i = 2 To Range("a65536").End(xlUp).Row

            If Year(Cells(i, 1)) = Then

                k = k + Cells(i, 4)

            End If

        Next

        = k

        k = 0

    End If

End Sub

用VBA统计满足条件的数据的个数，求大神，

Sub mysub()
    Dim countA As Integer
    Dim countB As Integer
    For i = 1 To Range("B65536").End(xlUp).Row
        If Cells(i, 2).Value =  Then
            If Cells(i + 2, "L").Value = "A" Then
                countA = countA + 1
            ElseIf Cells(i + 2, "L").Value = "B" Then
                countB = countB + 1
            End If
        End If
    Next
     = countA
     = countB
End Sub

excel vba 怎么对去重后的数据进行个数统计

测试数据：

程序代码：

执行效果：

代码文本：

Option Explicit

Sub 提重统计()

    Dim arr, db, i&, k, v

    Set db = CreateObject("Scripting.Dictionary")

    arr = Range("a1").CurrentRegion

    For i = 2 To UBound(arr)

        v = Trim(arr(i, 1))

        k = Trim(arr(i, 2))

        If Not db.Exists(k) Then db.Add k, CreateObject("Scripting.Dictionary")

        db(k)(v) = True

    Next i

    ReDim arr(1 To db.Count, 1 To 2)

    i = 0

    For Each k In db.Keys

        v = db(k).Count

        i = i + 1

        arr(i, 1) = k

        arr(i, 2) = v

    Next k

    Range("d3").Resize(i, 2) = arr

End Sub

利用VBA统计EXCEL中的数据

Sub 统计()
Dim i As Integer
Dim a As Integer
Cells(1, 1) = "序号"
Cells(1, 2) = "统计项目"
Cells(1, 3) = "统计总数"
For i = 2 To 12
a = 8 + i
Cells(i, 1) = i - 1
Cells(i, 2) = a
Cells(i, 3) = Application.WorksheetFunction.CountIf(Worksheets("sheet1").Range("A1:M12"), a)
Next i
End Sub
其实Application.WorksheetFunction.CountIf(Worksheets("sheet1").Range("A1:M12"), a)
也可以改成Application.CountIf(Worksheets("sheet1").Range("A1:M12"), a)

如何使用函数和VBA统计范围内的数值

楼主如果只要获得每一列符合条件的OK数和NG数，其实函数公式就够了，效率也很高。

示例1：在显示OK的单元格里输入 =COUNTIFS(B2:B21,"》0",B2:B21,"《0.05")；

示例2：在显示NG的单元格里输入 = 20 - OK的个数，即可。

如果想实现截图所示的效果：即用颜色区分开OK和NG属性的单元格，同时计算个数，则可以用VBA代码来实现。

Sub 计数并用颜色标记()
Dim rng As Range, c As Range, i%, ok%, ng%
Dim startRow&, endRow&
startRow = 2: endRow = 21 ’在此处定义数据区域的开始行和结束行，根据楼主截图，设定为2和21
i = 1
With Sheet1
    Do
        i = i + 1
        Set rng = .Range(.Cells(startRow, i), .Cells(endRow, i))
        ok = 0: ng = 0
        For Each c In rng
            If c.Value 》 0 And c.Value 《 0.05 Then
                c.Interior.Color = RGB(255, 0, 0) ’红色
                ok = ok + 1
            Else
                c.Interior.Color = RGB(0, 0, 255) ’蓝色
                ng = ng + 1
            End If
        Next
        .Cells(endRow + 1, i).Value = ok ’在数据检索区域的下一行写入ok的个数
        .Cells(endRow + 2, i).Value = ng ’在数据检索区域的下两行写入ng的个数
    Loop Until i = 5 ’i = 5意味着数据判断要执行完第E列再结束
End With
End Sub

关于EXCEL VBA编程做数据统计的请教！

Dim iRng As Range: Set iRng = Range("A1:A" & x + 1)
MsgBox Union(iRng.SpecialCells(xlCellTypeConstants, 23), _
iRng.SpecialCells(xlCellTypeFormulas, 23)).Cells.Count
----------------------
无论数据连续和间断都可用

利用Excel VBA统计一组数据的算法

示例公式：
=countif(a1:c100,*&"ABCD"&*)
示例公式统计A1:C100区域内有字符串ABCD的个数。
其中：OUNTIF函数统计单元格区域中满足给定条件的单元格的个数。语法结构为COUNTIF(rage,criteria)，参数range是需要统计符合条件单元格数目的单元格区域，参数criteria为指定的统计条件。