VBA的临时表管理工具设计与实现

在VBA开发过程中，临时表有很大的作用。然而，手工维护临时表，费时又费力。因此，笔者开发了一个临时表工具类。来简化临时表的维护，提高开发的效率。

使用临时表的意义

在操作数据表的时候，数据的乱序排列给我们的处理带来了很大的麻烦。利用Excel的排序机制，我们可以讲数据进行有效排序，在有序的数据基础上大大方便了数据的处理效率。

例子一：

查找某列的空白实体数

如图所示，经过排序以后，空白格子都排到了数据的最后去了。这样很方便统计出空白的格子数。

例子二：

例子一只是小case，现在介绍一个更加炫的。

这是一张学校信息表，这是一张乱序表。为了让大家看的更加清楚，我用颜色标识出了不同段的学生信息。颜色的鱼龙混杂，可以看出信息有多乱。

现在公司的老板说，这样的学生信息表太不直观了，于是需要建立一个视图，更加直观的标识学生信息。好的，程序的输入已经确定了，输入是乱序的学生信息表，输出是定制的学生信息视图。你现在心理面是不是在想，如果有SQL语句就好了。

不过没有关系，通过临时表机制，我们可以让工作简化。看看下面一张图，是不是思路会清晰多了？

通过建立临时表，并且使用Excel的排序功能，我们将信息按照三个不同的关键字排序，这样获取数据十分方便，只需要一个循环从上到下就把各类信息分门别类的清清楚楚了。

 

通过以上两个例子，大家可以看到临时表的牛逼之处，在于不改变原表格的数据的基础上，利用Excel的排序机制，方便数据处理，在使用完临时表以后，立马删除，不留一点痕迹。可是，如果使用代码维护临时表是一件很麻烦的事情。

手工操作临时表的麻烦

1 列的管理

使用历史表的过程中，由于我们不可能使用所有原表的所有的列，因此临时标的列号和原表的列号会不一样。这样造成了编程上的困难，因为我们必须去记忆原表映射到新表后是哪一列。下图1是原表，图2是根据原表生成的临时表。原表的2，4列到了新标以后是1，2列。如果需求改变，需要原表的1，2，4列，映射到临时表以后就是1，2，3列，代码改动量非常大，属于牵一发而动全身的改动。所以需要一个工具类来管理临时表的列。

/

2 排序后的行号管理

生成的临时表经过排序以后，原来的行号信息就失去了。如果我们需要改动原表的某行的相关数据，只能通过查找的方法，效率低下，而且可行性也不高（有重复数据的时候不可行）。如下图所示，红色圈的信息既是行号。这些信息排序后Excel是不会帮你自动保存的。所以，还是需要一个工具类来维护。

3 临时表名字管理

我们一般会怎样命名我们的临时表呢？’Temp’，’TempSheet’，’临时表’……关键是这些名字如果没有一个管理机制，就会以一种硬编码的形式存放于代码中，重名了怎么办？只能改代码，非常的不灵活。

4 建立子表

熟悉Excel的朋友都知道，Excel的排序只能支持3个关键字。如果需要6个关键字的排序怎么办？首先将所有的数据拷贝到临时表1中，按照关键次序先排前面的3个关键字，把前3关键字相同的数据拷贝到临时表2中，排序后3个关键字……这里面涉及到列的管理，行号的管理，名字的管理，可谓是前面3个临时表管理问题的综合应用。

临时表管理工具类的设计

临时表管理工具类的设计主要是为了解决上述的4个问题。因此我们也分为4个方面讲述。

1临时表列管理

列管理的混乱是由于没有一个统一的列号来标识，最好的方法就是用原来的列号作为该列唯一的标识，也就是说，如果原表的某列列号是5，那么无论在那一个层次的临时表，都用5来引用这个列。是不是很酷啊？

实现的原理很简单。类内部有一个数组成员，记录了原表和临时表列的对应关系。在存取数据的时候，只要查这个表格就可以了。

2 行号管理

为了记录行信息，在拷贝完原表数据以后，只要在临时表的最后一列利用Excel的AutoFill机制生成对应的行号信息即可。排序后，这些行号会紧紧的跟在数据列之后，供将来使用。

3 名字管理

工具类的构造函数会自动建立一个新的临时表。临时表名字=英文固定前缀+编号。在建立临时表之前，程序会自动检测是否会产生重名。如果产生了重名，编号自动加一，继续检测。直到检测不到重名为止。因此临时表的名字管理对于用户是透明的。

4 建立子表机制

工具类可以在建立的临时表基础上选取特定的列建立二级临时表。二级临时表也是由一个对象进行管理。管理的方法和原临时表一样。我们同样可以利用它建立一个三级临时表。以此类推。子表的名字也是由工具统一管理。

Sample

1. Set TempSheetManager nsh = New TempSheetManager’新建一个临时表，自动分配名字
2. nsh.setSheet(“Data”)’设定原表的名字为Data
3. cols = array(1,2,3,4)’需要拷贝的列为1，2，3，4
4. nsh.CopyCols(cols)’将原表的列拷贝到新标中去
5. nsh.SortCols(2,1,2,3)’从第二列开始，按照关键字1，2，3的顺序排序

实现

 

1. VERSION 1.0 CLASS
2. BEGIN
3.   MultiUse = -1  'True
4. END
5. Attribute VB_Name = "TempSheetManager"
6. Attribute VB_GlobalNameSpace = False
7. Attribute VB_Creatable = False
8. Attribute VB_PredeclaredId = False
9. Attribute VB_Exposed = False
10. Option Explicit
11. Private Const TempSheetFormat As String = "TempRound"
12. Private TempID As Integer
13. Private Sheet As String
14. Private ColumnMatch As Variant
15. Private nsh As Worksheet
16. Private sequenceCol As Integer
17. Public Sub setColumnMatch(c As Variant)
18.     ColumnMatch = c
19. End Sub
20. Public Sub setSheet(sh As String)
21.     Sheet = sh
22. End Sub
23. Public Sub Class_initialize()
24.     TempID = 1
25.     While SheetExist(TempSheetFormat & TempID)
26.         TempID = TempID + 1
27.     Wend
28.     Set nsh = Worksheets.add
29.     nsh.name = TempSheetFormat & TempID
30. End Sub
31. Public Sub CopyCols(cols As Variant, Optional sRow As Integer, Optional lRow As Integer)
32.     'ref = Mid(address1, 1, 1) & startRow & ":" & Mid(address1, 1, 1) & lastRow
33.     Call MySort(cols)
34.     ColumnMatch = cols
35.     
36.     Dim iMin As Long
37.     Dim iMax As Long
38.     Dim i As Long
39.     Dim ref As String
40.     Dim letter As String
41.     Dim Char As String
42.     Dim First As Integer
43.     Dim Last As Integer
44.     
45.     ref = ""
46.     iMin = LBound(ColumnMatch)
47.     iMax = UBound(ColumnMatch)
48.     For i = iMin To iMax - 1
49.         letter = LIB.ColLetter(CInt(ColumnMatch(i)))
50.         If sRow = 0 And lRow = 0 Then
51.             ref = ref & letter & ":" & letter & ","
52.         ElseIf sRow <> 0 And lRow <> 0 Then
53.             ref = ref & letter & sRow & ":" & letter & lRow & ","
54.         End If
55.     Next i
56.     letter = LIB.ColLetter(CInt(ColumnMatch(i)))
57.     If sRow = 0 And lRow = 0 Then
58.         First = 1
59.         ref = ref & letter & ":" & letter
60.     ElseIf sRow <> 0 And lRow <> 0 Then
61.         First = sRow
62.         ref = ref & letter & sRow & ":" & letter & lRow
63.     End If
64.     'Worksheets(Sheet).Activate
65.     'Worksheets(Sheet).Range(ref).Select
66.     'Selection.Copy
67.     Worksheets(Sheet).Activate
68.     Worksheets(Sheet).Range(ref).Copy
69.     nsh.Paste
70.     
71.     Last = 0
72.     For i = iMin To iMax
73.         If Last < nsh.Cells(nsh.Rows.Count, i + 1).End(xlUp).row Then
74.             Last = nsh.Cells(nsh.Rows.Count, i + 1).End(xlUp).row
75.         End If
76.     Next i
78.     sequenceCol = iMax - iMin + 2
79.     Char = ColLetter(sequenceCol)
80.     nsh.Cells(1, sequenceCol) = First
81.     nsh.Activate
82.     nsh.Range(Char & "1").AutoFill Destination:=Range(Char & "1:" & Char & Last), Type:=xlLinearTrend
83. End Sub
84. Public Sub SortCols(startRow As Integer, key1 As Integer, Optional key2 As Integer, Optional key3 As Integer)
85.     Dim k1 As Integer
86.     Dim k2 As Integer
87.     Dim k3 As Integer
88.     Dim sk1 As String
89.     Dim sk2 As String
90.     Dim sk3 As String
91.     Dim sortRange As Range
92.     Dim lastRow As Integer
93.     
94.     k1 = getMatchID(key1)
95.     If k1 = -1 Then Exit Sub
96.     sk1 = LIB.ColLetter(k1)
97.     
98.     lastRow = nsh.Cells(Rows.Count, k1).End(xlUp).row
99.     nsh.Activate
100.     Set sortRange = nsh.Cells.Rows(startRow & ":" & lastRow)
101.     
102.     If key2 = 0 Then
103.         sortRange.Sort key1:=nsh.Columns(sk1 & ":" & sk1), order1:=xlAscending, Header:= _
104.         xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
105.     ElseIf key3 = 0 Then
106.         k2 = getMatchID(key2)
107.         If k2 = -1 Then Exit Sub
108.         sk2 = LIB.ColLetter(k2)
109.         sortRange.Sort key1:=nsh.Columns(sk1 & ":" & sk1), order1:=xlAscending, _
110.         key2:=nsh.Columns(sk2 & ":" & sk2), order2:=xlAscending, Header:= _
111.         xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
112.     Else ' key3 <> 0
113.         k2 = getMatchID(key2)
114.         If k2 = -1 Then Exit Sub
115.         sk2 = LIB.ColLetter(k2)
116.         
117.         k3 = getMatchID(key3)
118.         If k3 = -1 Then Exit Sub
119.         sk3 = LIB.ColLetter(k3)
120.         sortRange.Sort key1:=nsh.Columns(sk1 & ":" & sk1), order1:=xlAscending, _
121.         key2:=nsh.Columns(sk2 & ":" & sk2), order2:=xlAscending _
122.         , key3:=nsh.Columns(sk3 & ":" & sk3), order3:=xlAscending, Header:= _
123.         xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
124.     End If
125. End Sub
127. Public Function Columns(col As Integer) As Range
128.     Columns = nsh.Columns(getMatchID(col))
129. End Function
130. Public Function Cells(row As Integer, col As Integer) As Variant
131.     Dim mCol As Integer
132.     mCol = getMatchID(col)
133.     Cells = nsh.Cells(row, mCol)
134. End Function
135. Public Function createSubTempSheetManager(cols As Variant, Optional sRow As Integer, Optional lRow As Integer) As TempSheetManager
136.     
137.     Dim tsm As TempSheetManager
138.     Dim col As Variant
139.     Dim iMin As Integer
140.     Dim iMax As Integer
141.     Dim i As Integer
142.     Dim bake As Variant
143.     iMin = LBound(cols)
144.     iMax = UBound(cols)
145.     
146.     
147.     If Not subArray(ColumnMatch, cols) Then
148.         Exit Function
149.     End If
150.     bake = cols
151.     Call MySort(bake)
152.     For i = iMin To iMax
153.         cols(i) = getMatchID(CInt(cols(i)))
154.     Next i
155. '    For Each col In cols
156. '        col = getMatchID(CInt(col))
157. '    Next col
158.     Set tsm = New TempSheetManager
159.     
160.     tsm.setSheet (nsh.name)
161.     If sRow = 0 And lRow = 0 Then
162.         Call tsm.CopyCols(cols)
163.     ElseIf sRow <> 0 And lRow <> 0 Then
164.         Call tsm.CopyCols(cols, sRow, lRow)
165.     End If
166.     
167.     tsm.setColumnMatch (bake)
168.     Set createSubTempSheetManager = tsm
169. '    For Each col In tsm.ColumnMatch
170. '        col = ColumnMatch(CInt(col))
171. '    Next col
172. End Function
173. Public Sub ReleaseMe()
174.     Application.DisplayAlerts = False
175.     nsh.Delete
176.     Application.DisplayAlerts = True
177. End Sub
178. Private Function subArray(ColumnMatch, cols) As Boolean
179.     subArray = True
180. End Function
181. Private Sub MySort(ByRef pvarArray As Variant)
182.     Dim i As Long
183.     Dim iMin As Long
184.     Dim iMax As Long
185.     Dim varSwap As Variant
186.     Dim blnSwapped As Boolean
187.     iMin = LBound(pvarArray)
188.     iMax = UBound(pvarArray) - 1
189.     Do
190.         blnSwapped = False
191.         For i = iMin To iMax
192.             If pvarArray(i) > pvarArray(i + 1) Then
193.                 varSwap = pvarArray(i)
194.                 pvarArray(i) = pvarArray(i + 1)
195.                 pvarArray(i + 1) = varSwap
196.                 blnSwapped = True
197.             End If
198.         Next
199.         iMax = iMax - 1
200.     Loop Until Not blnSwapped
201. End Sub
202. Private Function getMatchID(col As Integer) As Integer
203.     Dim i, iMin, iMax As Long
204.     iMin = LBound(ColumnMatch)
205.     iMax = UBound(ColumnMatch)
206.     For i = iMin To iMax
207.         If ColumnMatch(i) = col Then
208.             getMatchID = i + 1
209.             Exit Function
210.         End If
211.     Next i
212.     getMatchID = -1
213. End Function
215. Private Function SheetExist(Sheet As String) As Boolean
216.     Dim ws As Worksheet
217.     For Each ws In Worksheets
218.         If ws.name = Sheet Then
219.             SheetExist = True
220.             Exit Function
221.         End If
222.     Next ws
223.     SheetExist = False
224. End Function
226. Function getRow(row As Integer) As Integer
227.     getRow = nsh.Cells(row, sequenceCol)
228. End Function

 

总结

TempSheetManager工具类的实现大大降低了临时表的开发成本，使VBA的数据处理更加灵活。但由于笔者水平有限，设计上存在不少瑕疵，希望广大网友批评指点。