常用VBA代码

发表于 更新于

简介

在工作中不可避免的使用MsOffice完成大量重复性的工作，这些工作可以借助VBA来实现自动化，从而可以提高效率，同时便于将工作逐步完善以期得到更加标准的结果。本文收集了使用VBA处理日常工作中的常用代码，希望能够给大家的工作带来方便。

VBA排序代码

通常大家使用EXCEL时使用其自带的排序功能，但是在写成VBA脚本时，显然这不最好的方法。基于将数据调入内存后数据处理的高速性，研究出了此基于数组的排序方案，其代码如下：

VBA排序V1.0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Sub ReOrderEXE(ShName, ReCol,ReColed,BeginI,BeginJ)
Dim Imax, Jmax As Integer
Imax = Sheets(ShName).Cells(90000, 1).End(xlUp).Row
Jmax = Sheets(ShName).Cells(1, 200).End(xlToLeft).ReColumn
Dim i, j, k, p As Integer
Dim OutTab(1 To 1000, 1 To 2) As Variant
Dim InTab As Variant
InTab = Sheets(ShName).Range(Sheets(ShName).Cells(BeginI, BeginJ), Sheets(ShName).Cells(Imax, Jmax))
PaiMingStart:
p = p + 1
For i = 1 To Imax - BeginI
    If CInt(InTab(i, ReCol)) > CInt(OutTab(p, 2)) And InTab(i, ReCol) > 0 Then
        OutTab(p, 1) = InTab(i, 1)
        OutTab(p, 2) = InTab(i, ReCol)
    End If
Next
For i = 1 To Imax - BeginI
    If OutTab(p, 1) = InTab(i, 1) Then
        InTab(i, ReCol) = 0
    End If
Next
If p < Imax - BeginI Then
    GoTo PaiMingStart:
End If
For i = BeginI To Imax - 1
    For j = 1 To Imax - BeginI 
        If Sheets(ShName).Cells(i, 1) = OutTab(j, 1) Then
            Sheets(ShName).Cells(i, ReCol + 1) = j
        End If
    Next
Next
End Sub

Sub 排名()
    For r = 3 To 21 Step 2
     Call ReOrderEXE("一线", r, r+1, 4 ,3)
    Next
End Sub

下面说明工作原理：在第9行设置了GoTo的标定点，从第10行看起，p=p+1,则此时p=1,由于此时OutTab是空所以到第12行时，就会将InTab的第一组数据传递给OutTab,这样我们就得到了第1行数据到第Imax-BeginI的行数据中的最大值，并存储在OutTab的第一行。来到第17行，我们将OutTab与InTab逐行对比，则比对于刚才处理得到的最大数的一行，将InTab中的对应值置零。接着来到第22行，如果p<Imax - BeginI,则说明没有处理完所有行，此时将p=p+1 之后返回第9行，重新再筛选InTab中的各值，但是注意由于其条件InTab(i, ReCol) > 0的限制，则刚才处理的数将不再参与第二次筛选，于是第二次筛选将得到第二大的数，依次重复进行，直到处理完所有的数据，这样子在OutTab中的数据就是按照所需排序的列按大小顺序排列好的，并且会写入对应的ShName表中的对应列中，从而实现了使用宏排序。