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

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

使用临时表的意义
在操作数据表的时候，数据的乱序排列给我们的处理带来了很大的麻烦。利用Excel的排序机制，我们可以讲数据进行有效排序，在有序的数据基础上大大方便了数据的处理效率。
例子一：
查找某列的空白实体数





如图所示，经过排序以后，空白格子都排到了数据的最后去了。这样很方便统计出空白的格子数。
例子二：
例子一只是小case，现在介绍一个更加炫的。



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


现在公司的老板说，这样的学生信息表太不直观了，于是需要建立一个视图，更加直观的标识学生信息。好的，程序的输入已经确定了，输入是乱序的学生信息表，输出是定制的学生信息视图。你现在心理面是不是在想，如果有SQL语句就好了。
不过没有关系，通过临时表机制，我们可以让工作简化。看看下面一张图，是不是思路会清晰多了？



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

通过以上两个例子，大家可以看到临时表的牛逼之处，在于不改变原表格的数据的基础上，利用Excel的排序机制，方便数据处理，在使用完临时表以后，立马删除，不留一点痕迹。可是，如果使用代码维护临时表是一件很麻烦的事情。
手工操作临时表的麻烦[/b]
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个临时表管理问题的综合应用。
临时表管理工具类的设计[/b]
临时表管理工具类的设计主要是为了解决上述的4个问题。因此我们也分为4个方面讲述。
1临时表列管理
列管理的混乱是由于没有一个统一的列号来标识，最好的方法就是用原来的列号作为该列唯一的标识，也就是说，如果原表的某列列号是5，那么无论在那一个层次的临时表，都用5来引用这个列。是不是很酷啊？
实现的原理很简单。类内部有一个数组成员，记录了原表和临时表列的对应关系。在存取数据的时候，只要查这个表格就可以了。
2 行号管理
为了记录行信息，在拷贝完原表数据以后，只要在临时表的最后一列利用Excel的AutoFill机制生成对应的行号信息即可。排序后，这些行号会紧紧的跟在数据列之后，供将来使用。



3 名字管理
工具类的构造函数会自动建立一个新的临时表。临时表名字=英文固定前缀+编号。在建立临时表之前，程序会自动检测是否会产生重名。如果产生了重名，编号自动加一，继续检测。直到检测不到重名为止。因此临时表的名字管理对于用户是透明的。
4 建立子表机制
工具类可以在建立的临时表基础上选取特定的列建立二级临时表。二级临时表也是由一个对象进行管理。管理的方法和原临时表一样。我们同样可以利用它建立一个三级临时表。以此类推。子表的名字也是由工具统一管理。
Sample[/b]

Set TempSheetManager nsh = New TempSheetManager’新建一个临时表，自动分配名字

nsh.setSheet(“Data”)’设定原表的名字为Data

cols = array(1,2,3,4)’需要拷贝的列为1，2，3，4

nsh.CopyCols(cols)’将原表的列拷贝到新标中去

nsh.SortCols(2,1,2,3)’从第二列开始，按照关键字1，2，3的顺序排序

实现

VERSION 1.0 CLASS

BEGIN

MultiUse = -1 'True

END

Attribute VB_Name = "TempSheetManager"

Attribute VB_GlobalNameSpace = False

Attribute VB_Creatable = False

Attribute VB_PredeclaredId = False

Attribute VB_Exposed = False

Option Explicit

Private Const TempSheetFormat As String = "TempRound"

Private TempID As Integer

Private Sheet As String

Private ColumnMatch As Variant

Private nsh As Worksheet

Private sequenceCol As Integer

Public Sub setColumnMatch(c As Variant)

ColumnMatch = c

End Sub

Public Sub setSheet(sh As String)

Sheet = sh

End Sub

Public Sub Class_initialize()

TempID = 1

While SheetExist(TempSheetFormat & TempID)

TempID = TempID + 1

Wend

Set nsh = Worksheets.add

nsh.name = TempSheetFormat & TempID

End Sub

Public Sub CopyCols(cols As Variant, Optional sRow As Integer, Optional lRow As Integer)

'ref = Mid(address1, 1, 1) & startRow & ":" & Mid(address1, 1, 1) & lastRow

Call MySort(cols)

ColumnMatch = cols

Dim iMin As Long

Dim iMax As Long

Dim i As Long

Dim ref As String

Dim letter As String

Dim Char As String

Dim First As Integer

Dim Last As Integer

ref = ""

iMin = LBound(ColumnMatch)

iMax = UBound(ColumnMatch)

For i = iMin To iMax - 1

letter = LIB.ColLetter(CInt(ColumnMatch(i)))

If sRow = 0 And lRow = 0 Then

ref = ref & letter & ":" & letter & ","

ElseIf sRow <> 0 And lRow <> 0 Then

ref = ref & letter & sRow & ":" & letter & lRow & ","

End If

Next i

letter = LIB.ColLetter(CInt(ColumnMatch(i)))

If sRow = 0 And lRow = 0 Then

First = 1

ref = ref & letter & ":" & letter

ElseIf sRow <> 0 And lRow <> 0 Then

First = sRow

ref = ref & letter & sRow & ":" & letter & lRow

End If

'Worksheets(Sheet).Activate

'Worksheets(Sheet).Range(ref).Select

'Selection.Copy

Worksheets(Sheet).Activate

Worksheets(Sheet).Range(ref).Copy

nsh.Paste

Last = 0

For i = iMin To iMax

If Last < nsh.Cells(nsh.Rows.Count, i + 1).End(xlUp).row Then

Last = nsh.Cells(nsh.Rows.Count, i + 1).End(xlUp).row

End If

Next i

sequenceCol = iMax - iMin + 2

Char = ColLetter(sequenceCol)

nsh.Cells(1, sequenceCol) = First

nsh.Activate

nsh.Range(Char & "1").AutoFill Destination:=Range(Char & "1:" & Char & Last), Type:=xlLinearTrend

End Sub

Public Sub SortCols(startRow As Integer, key1 As Integer, Optional key2 As Integer, Optional key3 As Integer)

Dim k1 As Integer

Dim k2 As Integer

Dim k3 As Integer

Dim sk1 As String

Dim sk2 As String

Dim sk3 As String

Dim sortRange As Range

Dim lastRow As Integer

k1 = getMatchID(key1)

If k1 = -1 Then Exit Sub

sk1 = LIB.ColLetter(k1)

lastRow = nsh.Cells(Rows.Count, k1).End(xlUp).row

nsh.Activate

Set sortRange = nsh.Cells.Rows(startRow & ":" & lastRow)

If key2 = 0 Then

sortRange.Sort key1:=nsh.Columns(sk1 & ":" & sk1), order1:=xlAscending, Header:= _

xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

ElseIf key3 = 0 Then

k2 = getMatchID(key2)

If k2 = -1 Then Exit Sub

sk2 = LIB.ColLetter(k2)

sortRange.Sort key1:=nsh.Columns(sk1 & ":" & sk1), order1:=xlAscending, _

key2:=nsh.Columns(sk2 & ":" & sk2), order2:=xlAscending, Header:= _

xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Else ' key3 <> 0

k2 = getMatchID(key2)

If k2 = -1 Then Exit Sub

sk2 = LIB.ColLetter(k2)

k3 = getMatchID(key3)

If k3 = -1 Then Exit Sub

sk3 = LIB.ColLetter(k3)

sortRange.Sort key1:=nsh.Columns(sk1 & ":" & sk1), order1:=xlAscending, _

key2:=nsh.Columns(sk2 & ":" & sk2), order2:=xlAscending _

, key3:=nsh.Columns(sk3 & ":" & sk3), order3:=xlAscending, Header:= _

xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

End If

End Sub

Public Function Columns(col As Integer) As Range

Columns = nsh.Columns(getMatchID(col))

End Function

Public Function Cells(row As Integer, col As Integer) As Variant

Dim mCol As Integer

mCol = getMatchID(col)

Cells = nsh.Cells(row, mCol)

End Function

Public Function createSubTempSheetManager(cols As Variant, Optional sRow As Integer, Optional lRow As Integer) As TempSheetManager

Dim tsm As TempSheetManager

Dim col As Variant

Dim iMin As Integer

Dim iMax As Integer

Dim i As Integer

Dim bake As Variant

iMin = LBound(cols)

iMax = UBound(cols)

If Not subArray(ColumnMatch, cols) Then

Exit Function

End If

bake = cols

Call MySort(bake)

For i = iMin To iMax

cols(i) = getMatchID(CInt(cols(i)))

Next i

' For Each col In cols

' col = getMatchID(CInt(col))

' Next col

Set tsm = New TempSheetManager

tsm.setSheet (nsh.name)

If sRow = 0 And lRow = 0 Then

Call tsm.CopyCols(cols)

ElseIf sRow <> 0 And lRow <> 0 Then

Call tsm.CopyCols(cols, sRow, lRow)

End If

tsm.setColumnMatch (bake)

Set createSubTempSheetManager = tsm

' For Each col In tsm.ColumnMatch

' col = ColumnMatch(CInt(col))

' Next col

End Function

Public Sub ReleaseMe()

Application.DisplayAlerts = False

nsh.Delete

Application.DisplayAlerts = True

End Sub

Private Function subArray(ColumnMatch, cols) As Boolean

subArray = True

End Function

Private Sub MySort(ByRef pvarArray As Variant)

Dim i As Long

Dim iMin As Long

Dim iMax As Long

Dim varSwap As Variant

Dim blnSwapped As Boolean

iMin = LBound(pvarArray)

iMax = UBound(pvarArray) - 1

Do

blnSwapped = False

For i = iMin To iMax

If pvarArray(i) > pvarArray(i + 1) Then

varSwap = pvarArray(i)

pvarArray(i) = pvarArray(i + 1)

pvarArray(i + 1) = varSwap

blnSwapped = True

End If

Next

iMax = iMax - 1

Loop Until Not blnSwapped

End Sub

Private Function getMatchID(col As Integer) As Integer

Dim i, iMin, iMax As Long

iMin = LBound(ColumnMatch)

iMax = UBound(ColumnMatch)

For i = iMin To iMax

If ColumnMatch(i) = col Then

getMatchID = i + 1

Exit Function

End If

Next i

getMatchID = -1

End Function

Private Function SheetExist(Sheet As String) As Boolean

Dim ws As Worksheet

For Each ws In Worksheets

If ws.name = Sheet Then

SheetExist = True

Exit Function

End If

Next ws

SheetExist = False

End Function

Function getRow(row As Integer) As Integer

getRow = nsh.Cells(row, sequenceCol)

End Function

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