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的值如下.