Excel VBA入门(9):实例汇总

实例1: 统计每一个人的培训天数

原始数据以下:

个人思路: 把E列的名字分开来,(都是逗号做为分隔符), 根据天数复制这些人名, 最后统计每个人名出现的次数便可.

step1: E 列的人名分割

使用数据分列

获得结果以下

step2 : 根据天数复制名字, 好比第四行的E,F列, 复制2-1=1次!

VBA程序以下: 

Sub test1()
    Dim w As Worksheet
    Set w = Worksheets("2018年修改")

    Dim i As Integer, j As Integer, num As Integer, col As Integer
    Dim r As Range, rr As Range
    
    ' rr是须要复制的单元格 固定
    For i = 4 To 10 Step 1 ' 多少行
        num = Range("C" & i) - 1 '复制次数
        Debug.Print "复制次数" & num
        
        col = w.Range("E" & i).End(xlToRight).Column
        
        If col = 256 Then
            Set rr = w.Range("E" & i)
        Else
            Set rr = w.Range(Cells(i, 5), Cells(i, col)) '肯定要复制的单元格
        End If
        
        '定位最右边的第一个单元格
        For j = 1 To num Step 1
            Set r = w.Range("A" & i).End(xlToRight).Offset(0, 1)
            rr.Copy r '复制
        Next j
        
    Next i
End Sub

获得

而后把这些数据放在一块儿, 去重,  统计每一个人的出现次数便可.

一列数据的去重很简单, 只须要选中这一列, 删除重复项便可. 如何作一个区域的去重?

实例(2): 区域的数据去重

原始状况以下

VBA代码以下

Sub test3()  ' 区域去重
Dim Rng As Range, Arr, i As Long, j As Long, T As Boolean
j = 1
ReDim Arr(1 To 1)  ' arr 用来存储非重复项
T = True
For Each Rng In Selection
    If Rng.Value <> "" Then
        For i = 1 To j  ' j 是arr的长度, 遍历arr每一项
            If Arr(i) = Rng.Value Then ' 出现重复了
            Rng.Value = "" ' 删除重复的单元格内容
            T = False
            Exit For
            End If
        Next
        If T Then  ' 不是重复值
            j = j + 1 ' 增长数组长度
            ReDim Preserve Arr(1 To j)
            Arr(j) = Rng.Value ' 存储该单元格到数组中
        End If
        T = True
    End If
Next
Range("E1:E" & j) = Application.WorksheetFunction.Transpose(Arr) ' 获得不重复项
End Sub

注意: ReDim Preserve的做用是从新分配数组空间 默认状况下从新分配空间后数组内容都会清空,加上preserve后能够保留原来的数据在进行分配空间!

获得结果. 其中监视arr的值以下.