CSDN博客

img RosickyNewBee

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

发表于2008/10/3 14:21:00  1206人阅读

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


使用临时表的意义

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

例子一:

查找某列的空白实体数


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

例子二:

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

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

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

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

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

 

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

手工操作临时表的麻烦

1 列的管理

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

/

2 排序后的行号管理

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

3 临时表名字管理

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

4 建立子表

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

临时表管理工具类的设计

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

1临时表列管理

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

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

2 行号管理

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

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 VariantOptional sRow As IntegerOptional 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
  77.     sequenceCol = iMax - iMin + 2
  78.     Char = ColLetter(sequenceCol)
  79.     nsh.Cells(1, sequenceCol) = First
  80.     nsh.Activate
  81.     nsh.Range(Char & "1").AutoFill Destination:=Range(Char & "1:" & Char & Last), Type:=xlLinearTrend
  82. End Sub
  83. Public Sub SortCols(startRow As Integer, key1 As IntegerOptional key2 As IntegerOptional key3 As Integer)
  84.     Dim k1 As Integer
  85.     Dim k2 As Integer
  86.     Dim k3 As Integer
  87.     Dim sk1 As String
  88.     Dim sk2 As String
  89.     Dim sk3 As String
  90.     Dim sortRange As Range
  91.     Dim lastRow As Integer
  92.     
  93.     k1 = getMatchID(key1)
  94.     If k1 = -1 Then Exit Sub
  95.     sk1 = LIB.ColLetter(k1)
  96.     
  97.     lastRow = nsh.Cells(Rows.Count, k1).End(xlUp).row
  98.     nsh.Activate
  99.     Set sortRange = nsh.Cells.Rows(startRow & ":" & lastRow)
  100.     
  101.     If key2 = 0 Then
  102.         sortRange.Sort key1:=nsh.Columns(sk1 & ":" & sk1), order1:=xlAscending, Header:= _
  103.         xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
  104.     ElseIf key3 = 0 Then
  105.         k2 = getMatchID(key2)
  106.         If k2 = -1 Then Exit Sub
  107.         sk2 = LIB.ColLetter(k2)
  108.         sortRange.Sort key1:=nsh.Columns(sk1 & ":" & sk1), order1:=xlAscending, _
  109.         key2:=nsh.Columns(sk2 & ":" & sk2), order2:=xlAscending, Header:= _
  110.         xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
  111.     Else ' key3 <> 0
  112.         k2 = getMatchID(key2)
  113.         If k2 = -1 Then Exit Sub
  114.         sk2 = LIB.ColLetter(k2)
  115.         
  116.         k3 = getMatchID(key3)
  117.         If k3 = -1 Then Exit Sub
  118.         sk3 = LIB.ColLetter(k3)
  119.         sortRange.Sort key1:=nsh.Columns(sk1 & ":" & sk1), order1:=xlAscending, _
  120.         key2:=nsh.Columns(sk2 & ":" & sk2), order2:=xlAscending _
  121.         , key3:=nsh.Columns(sk3 & ":" & sk3), order3:=xlAscending, Header:= _
  122.         xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
  123.     End If
  124. End Sub
  125. Public Function Columns(col As IntegerAs Range
  126.     Columns = nsh.Columns(getMatchID(col))
  127. End Function
  128. Public Function Cells(row As Integer, col As IntegerAs Variant
  129.     Dim mCol As Integer
  130.     mCol = getMatchID(col)
  131.     Cells = nsh.Cells(row, mCol)
  132. End Function
  133. Public Function createSubTempSheetManager(cols As VariantOptional sRow As IntegerOptional lRow As IntegerAs TempSheetManager
  134.     
  135.     Dim tsm As TempSheetManager
  136.     Dim col As Variant
  137.     Dim iMin As Integer
  138.     Dim iMax As Integer
  139.     Dim i As Integer
  140.     Dim bake As Variant
  141.     iMin = LBound(cols)
  142.     iMax = UBound(cols)
  143.     
  144.     
  145.     If Not subArray(ColumnMatch, cols) Then
  146.         Exit Function
  147.     End If
  148.     bake = cols
  149.     Call MySort(bake)
  150.     For i = iMin To iMax
  151.         cols(i) = getMatchID(CInt(cols(i)))
  152.     Next i
  153. '    For Each col In cols
  154. '        col = getMatchID(CInt(col))
  155. '    Next col
  156.     Set tsm = New TempSheetManager
  157.     
  158.     tsm.setSheet (nsh.name)
  159.     If sRow = 0 And lRow = 0 Then
  160.         Call tsm.CopyCols(cols)
  161.     ElseIf sRow <> 0 And lRow <> 0 Then
  162.         Call tsm.CopyCols(cols, sRow, lRow)
  163.     End If
  164.     
  165.     tsm.setColumnMatch (bake)
  166.     Set createSubTempSheetManager = tsm
  167. '    For Each col In tsm.ColumnMatch
  168. '        col = ColumnMatch(CInt(col))
  169. '    Next col
  170. End Function
  171. Public Sub ReleaseMe()
  172.     Application.DisplayAlerts = False
  173.     nsh.Delete
  174.     Application.DisplayAlerts = True
  175. End Sub
  176. Private Function subArray(ColumnMatch, cols) As Boolean
  177.     subArray = True
  178. End Function
  179. Private Sub MySort(ByRef pvarArray As Variant)
  180.     Dim i As Long
  181.     Dim iMin As Long
  182.     Dim iMax As Long
  183.     Dim varSwap As Variant
  184.     Dim blnSwapped As Boolean
  185.     iMin = LBound(pvarArray)
  186.     iMax = UBound(pvarArray) - 1
  187.     Do
  188.         blnSwapped = False
  189.         For i = iMin To iMax
  190.             If pvarArray(i) > pvarArray(i + 1) Then
  191.                 varSwap = pvarArray(i)
  192.                 pvarArray(i) = pvarArray(i + 1)
  193.                 pvarArray(i + 1) = varSwap
  194.                 blnSwapped = True
  195.             End If
  196.         Next
  197.         iMax = iMax - 1
  198.     Loop Until Not blnSwapped
  199. End Sub
  200. Private Function getMatchID(col As IntegerAs Integer
  201.     Dim i, iMin, iMax As Long
  202.     iMin = LBound(ColumnMatch)
  203.     iMax = UBound(ColumnMatch)
  204.     For i = iMin To iMax
  205.         If ColumnMatch(i) = col Then
  206.             getMatchID = i + 1
  207.             Exit Function
  208.         End If
  209.     Next i
  210.     getMatchID = -1
  211. End Function
  212. Private Function SheetExist(Sheet As StringAs Boolean
  213.     Dim ws As Worksheet
  214.     For Each ws In Worksheets
  215.         If ws.name = Sheet Then
  216.             SheetExist = True
  217.             Exit Function
  218.         End If
  219.     Next ws
  220.     SheetExist = False
  221. End Function
  222. Function getRow(row As IntegerAs Integer
  223.     getRow = nsh.Cells(row, sequenceCol)
  224. End Function

 

总结

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

 

0 0

相关博文

我的热门文章

img
取 消
img