VBA DataAutomation数据处理类模块,一行代码搞定复杂数据

905738810

Public Function 行列改变([ByVal 行 As Long = 0], [ByVal 列 As Long = 0], [ByVal 原数据先行后列 As Boolean = True], [ByVal 新数据先行后列 As Boolean = True]) As DataAutomation
重新定义da数据大小(行数，列数)，将原da数据按顺序(先行后列,先列后行)写入新的da数据大小中
第1参数：新数据的行数
第2参数：新数据的列数
第3参数：原数据取出顺序
第4参数：新数据写入顺序
我真的不知道如何描述这个方法了，对于不理解的，da类的源码都在那里可以看源码演示1：一列变两列

演示2：两列变一列

leolee82

每个玩VBA的都有自己写的一套代码库。感谢楼主能分享源码，这个应该是今年看到的最值得点值得点赞的帖子。
代码很漂亮，个人觉得函数名、变量名改成英文的会更实用些。


关于用CallWindowProc回调，我之前简单测试过，记得比接口形式慢一些，几倍而已，不过用起来方便，不用搞一堆类模块。

905738810

leolee82 发表于 2021-11-28 14:47
每个玩VBA的都有自己写的一套代码库。感谢楼主能分享源码，这个应该是今年看到的最值得点值得点赞的帖子。
...

CallWindowPro方式速度是最快的比起接口还要快很多，可以参考我的回调函数贴
首先我不懂一点英文，其次我觉的中文可以省去很多注释，方法即注释

leolee82

905738810 发表于 2021-11-28 15:24
CallWindowPro方式速度是最快的比起接口还要快很多，可以参考我的回调函数贴
首先我不懂一点英文，其次 ...

不懂英文都这么强，佩服！
看了你的代码，不少都是和我自己的重复,哈哈
比如，一维二维转换我的函数名是ArrayRedim, 转一维我的函数是ArrayFlat:递归实现的，支持各种嵌套，效率有点低。
另外，发现你代码循环中的Redim Preserve可以优化，一次多申请些空间，最后再Redim Preserve成合适的大小。可以参考C++ STL中的Vector，下面是我自己用的，凑合看吧，没整理。

'扩展数组空间 需保证arr1D为一维数组
'使用方法
'Call Array1D_Expand_(arr, iUboundTest)
'iUboundTest: 当前期望的Ubound. 如果iUboundTest > iUB 则ReDim Preserve arr1D(iLB To iLB + 1.3 * iUboundTest + iCountAdd)
Sub Array1D_Expand_(arr1D, ByVal iUboundTest As Long, Optional ByVal iCountAdd As Long = 5)
'    If IsArray(arr1D) = False Then Exit Sub
    Dim iLB As Long, iUB As Long
   
'    If IsArray(arr1D) Then
        iLB = LBound(arr1D)
        iUB = UBound(arr1D)
   
        If iUboundTest < 0 Then iUboundTest = iUB
        If iUboundTest <= iUB Then Exit Sub
        ReDim Preserve arr1D(iLB To iLB + 1.3 * iUboundTest + iCountAdd)
'    Else
'        ReDim arr1D(0 To iCountAdd)
'    End If
End Sub

另外，关于WindowsAPI操作数组，不能直接CopyMemory，可以去搜索下SafeArray。不过比较难搞，再加上Variant，我就放弃了，哈哈。相关的API有：SafeArrayGetDim SafeArrayCreate SafeArrayAccessData SafeArrayGetElemsize SafeArrayLock SafeArrayUnlock等

905738810

leolee82 发表于 2021-11-28 19:54
不懂英文都这么强，佩服！
看了你的代码，不少都是和我自己的重复,哈哈
比如，一维二维转换我的函数名 ...

感谢只点，确实有一个函数我认为处理数据少而懒得写了，直接无限用了ReDim Preserve
程序应该严紧，我会将他改正
关于WindowsAPI方法也考虑用过，但是WindowsAPI方法针对不同的数据类型的内存偏移都不一致，类型处理起来很麻烦，最后也不采用了
我就分享下我曾经放弃的API方法吧，就刚才所言只支持Variant类型数组，其他类型还要修改代码
多维数组转一维，支持任意维度，这个想法是突发奇想的，
可以想一想，在不知道数组维度的情况下如何不用foreach遍历整个数组,我只想到了这个api方法？

1. Private Type SAFEARRAY
   
2.     cDims        As Integer
   
3.     fFeatures    As Integer
   
4.     cbElements   As Long
   
5.     cLocks       As Long
   
6.     pvData       As LongPtr
   
7. End Type
   
8. Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
   
9. ByRef Destination As Any, _
   
10. ByRef Source As Any, _
    
11. ByVal Length As Long)
    
12. Private Declare PtrSafe Function VarPtrArray Lib "VBE7" Alias _
    
13. "VarPtr" (ByRef Var() As Any) As LongPtr
    
14. 
    
15. '支持任意维度
    
16. Private Function 多维转一维(arr()) As Variant()
    
17.     Dim v1 As LongPtr
    
18.     Dim s As SAFEARRAY
    
19.     Dim psa As LongPtr
    
20.     '得到数组信息地址
    
21.     CopyMemory psa, ByVal VarPtrArray(arr), 4
    
22.     '读取数组信息
    
23.     #If Win64 Then
    
24.         CopyMemory s, ByVal psa, 20
    
25.     #Else
    
26.         CopyMemory s, ByVal psa, 16
    
27.     #End If
    
28.     v1 = s.pvData                                '数组真实地址
    
29.     '取得数组元素总个数
    
30.     Dim cc As Long
    
31.     cc = 1
    
32.     For i = 1 To s.cDims
    
33.         cc = cc * (UBound(arr, i) - LBound(arr, i) + 1)
    
34.     Next
    
35.     Dim arr1
    
36.     '构造一维数组
    
37.     ReDim arr1(1 To cc)
    
38.     '将多维复制地址到一维
    
39.     CopyMemory arr1(1), ByVal v1, s.cbElements * cc
    
40.     多维转一维 = arr1
    
41.     '最后释放掉 arr1 以内出现崩溃
    
42.     CopyMemory arr1, 0&, 4
    
43. End Function
    
44. 
    
45. Sub 测试二维()
    
46.     Dim v(2 To 8, 2 To 8)
    
47.     For i = 2 To 8
    
48.         For j = 2 To 8
    
49.             v(i, j) = i & "," & j
    
50.         Next
    
51.     Next
    
52.     arr = 多维转一维(v)
    
53. End Sub
    
54. 
    
55. Sub 测试三维()
    
56.     Dim v(2 To 8, 2 To 8, 1 To 10)
    
57.     For i = 2 To 8
    
58.         For j = 2 To 8
    
59.             For k = 1 To 10
    
60.                 v(i, j, k) = i & "," & j & "," & k
    
61.             Next
    
62.         Next
    
63.     Next
    
64.     arr = 多维转一维(v)
    
65. End Sub

复制代码

蓝桥玄霜

前面各个帖子中涉及的实例附件能上传吗？以便于大家测试学习。

905738810

蓝桥玄霜 发表于 2021-11-28 22:28
前面各个帖子中涉及的实例附件能上传吗？以便于大家测试学习。

都是临时写的没保存，等方法写完，我会写几个案例，到时候会有附件

米莉沙

等待案例与附件学习

905738810

Public Function 拼接行列([ByVal 列标arr = 0], [ByVal 行标arr = 0], [ByVal 分隔符 As String = ","]) As DataAutomation
可以实现对数据的字符串拼接，返回一个新的da实例，用来装拼接后的数组
第1参数：要拼接的列索引或列索引数组
第2参数：要拼接的行索引或行索引数组
第3参数：拼接的分隔符[默认为","]
演示1：参数只传列索引时

演示2：参数只传行索引时

演示3：参数行，列索引都传时(会按笛卡尔积形式拼接)

演示4：参数行，列索引传数组时

大家也发现了，从讲完组以后，后面讲的da方法比较灵活，难理解，建议自己亲自试一试

905738810

接下来就将讲解da类中字典的用法
da类中可以对da数据设置字典索引，有如下两方法
Public Function 字典设置行索引(ByVal arr) As DataAutomation
针对一维表(只有列字段)设置行索引（采用拼接指定的列内容生成字典key）
生成字典的可以字段中间会有","分隔
第1参数：列索引或列索引数组（参考去重参数）
Public Function 字典设置行列索引(ByVal 行标arr, ByVal 列标arr) As DataAutomation
针对二维表（包含行列字段）设置索引（采用笛卡尔积拼接形式生成字典key）
生成字典的可以字段中间会有","分隔
第1参数：行索引或行索引数组（参考拼接行列）
第2参数：列索引或列索引数组（参考拼接行列）
两个方法运行后并没有效果，只是向da实例中存储了字典索引，可以在本地窗口中查看隐藏属性[字典索引]，
需要配合下面方法取出数据，可以实现查找效果
Public Function 字典取行(ByVal arrStr) As DataAutomation
传入key对应的，从da数据中取出数据，会生成一个新的da实例
第1参数：key数组
Public Function 字典取行列(ByVal 行arrStr, ByVal 列arrStr, [ByVal index As Long = 1]) As DataAutomation
传入行key以及列key对应的，从da数据中取出数据，会生成一个新的da实例
第1参数：行key数组
第2参数：列key数组
第3参数：当运行的是字典设置行索引时，使用字典取行列方法会转为二维表，这时需要指定哪一列为二维表数据
演示1：字典设置行索引配合字典取行(一维表查找一维表)

演示2：字典设置行列索引配合字典取行(一维表查找二维表)

演示3：字典设置行索引配合字典取行列(二维表查找一维表)

演示3：字典设置行列索引配合字典取行列(二维表查找二维表)

da字典.rar (258.18 KB, 下载次数: 16)

2021-11-30 16:50 上传

点击文件名下载附件

此方法不好理解，特上传图片示例