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

原创 2008年10月03日 14:21:00

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


使用临时表的意义<?xml:namespace prefix = o />

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

例子一:

查找某列的空白实体数


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

例子二:

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

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

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

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

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

<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" />

 

通过以上两个例子,大家可以看到临时表的牛逼之处,在于不改变原表格的数据的基础上,利用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的数据处理更加灵活。但由于笔者水平有限,设计上存在不少瑕疵,希望广大网友批评指点。

 

#临时表和##临时表区别

 临时表有两种类型: 本地临时表 以一个井号 (#) 开头的那些表名。只有在创建本地临时表的连接上才能看到这些表。 全局临时表 以两个井号 (##) 开头的那些表名。在所有连接上都能看到全局临时表。如...
  • dragonfly0939
  • dragonfly0939
  • 2008年10月28日 22:15
  • 605

多行数据插入,使用临时表

using System; using System.Collections.Generic; using System.Linq; using System.Web; using System.We...
  • G1036583997
  • G1036583997
  • 2014年01月14日 11:42
  • 2748

读《Linux内核设计与实现》我想到了这些书

从题目中可以看到,这篇文章是以我读《Linux内核设计与实现》而想到的其他我读过的书,所以,这篇文章的主要支撑点是《Linux内核》。      开始读这本书已经是很久以前的事了,不过,由于时间和精力...
  • DLUTBruceZhang
  • DLUTBruceZhang
  • 2013年08月19日 08:59
  • 10005

Windows 进程管理工具的设计与实现

Windows 进程管理工具的设计与实现 引子 前阵子曾提到过为了应某些人的需要,得做几个毕业设计,其中一个就是 Windows 的进程管理工具 。 在前期的...
  • pi9nc
  • pi9nc
  • 2013年06月12日 16:04
  • 853

应用框架的设计与实现——.NET平台(3)

框架开发的技术和方法1.通用点(技术)  通用点代表业务应用中反复出现的通用主题的位置。  只要差异不大,你依然可以把这个主题作为通用点;只是,需要通过参数化或配置设置项的方法,来处理这些小的变化。 ...
  • dongma_yifei
  • dongma_yifei
  • 2006年08月20日 17:53
  • 857

读书笔记《Lua设计与实现》 了解Lua底层

十一抽时间看了这本书。        还记得第一次接触Lua 是在2014年7月份, 当时还是在长春实习(Cocos Lua), 接触了一个多月就来北京开始了Unity我是很喜欢看纸质书的,不太喜欢看...
  • u010019717
  • u010019717
  • 2017年10月08日 15:13
  • 2394

Java面试准备十八:数据库——临时表、视图

Oracle临时表 Oracle视图 参考Oracle临时表总结 Oracle临时表 Oracle视图说明1. Oracle临时表 临时表概念(1)临时表只在Oracle 8i以上产品中支持。...
  • u013349237
  • u013349237
  • 2017年04月23日 01:15
  • 730

Android Binder设计与实现 - 实现篇

http://www.cnblogs.com/albert1017/p/3849585.html 前言       在学习Android的Binder机制时,看了http:...
  • laviolette
  • laviolette
  • 2014年07月31日 09:42
  • 1534

【Linux内核设计与实现】Linux内核简介

之前在读《APUE》的时候,更多的是从上层去了解如何使用Linux系统的API,那个时候就十分喜欢Linux的设计,觉得一切都很奇妙。最近有些迷茫,不知道自己以后更加具体的技术方向在哪,所以最近广泛阅...
  • jiange_zh
  • jiange_zh
  • 2016年09月22日 11:22
  • 1259

mysql 临时表和视图

视图是虚表,操作视图会更新实体表的数据。 视图跟其它实体表共享一个命名空间,因此不能与实体表重名 视图不会随着会话结束而消失临时表跟实体表是两个互不相干的两个表,因此不存在操作临时表会影响到实体表...
  • tzh_linux
  • tzh_linux
  • 2017年04月26日 10:50
  • 381
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:VBA的临时表管理工具设计与实现
举报原因:
原因补充:

(最多只允许输入30个字)