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