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

      

 

转载于:https://www.cnblogs.com/xuying-fall/p/11398940.html