【CopyMemory】截取数组的一部分赋值给另一个数组

ykcbf1100

自适应

1. Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
   
2. 
   
3. Sub test()   '//数组部分复制
   
4.     Dim arr, brr, i&, j&
   
5.     arr = [a1:d30]
   
6.     ReDim brr(1 To 20, 1 To 2)
   
7.     '取第2~3列的第11~20行数据给brr数组
   
8.    
   
9.     sArch = LCase(Environ("PROCESSOR_ARCHITECTURE"))
   
10.     If sArch = "amd64" Then     ' 对于64位Office，检查PROCESSOR_ARCHITECTURE是否为amd64
    
11.         num = 24
    
12.     ElseIf sArch = "x86" Then   ' 对于32位Office，检查PROCESSOR_ARCHITECTURE是否为x86
    
13.         num = 16
    
14.     End If
    
15.    
    
16.     For i = 1 To 2
    
17.         CopyMemory brr(1, i), arr(11, i + 1), 20 * num '单元格数组每个元素占24个字节
    
18.     Next i
    
19.     [f1].Resize(20, 2) = brr
    
20. End Sub
    
21. 
    

复制代码

32位和64位系统。

morpheus126

仰望中，谢谢分享！

大灰狼1976

我公司里也是64位，下班后家里的32位测试一下，谢谢了

tspliu

我都不敢用CopyMemory，老把程序干死机，有时候文件还莫名丢失了

morpheus126

ykcbf1100 发表于 2024-8-15 09:35
自适应
32位和64位系统。

请教一下，抬头的API定义是不是要加上#IF VBA7 THEN...

ykcbf1100

morpheus126 发表于 2024-8-15 10:05
请教一下，抬头的API定义是不是要加上#IF VBA7 THEN...

不用啊。。。

ynzsvt

tspliu 发表于 2024-8-15 10:01
我都不敢用CopyMemory，老把程序干死机，有时候文件还莫名丢失了

要胆大心细，了解了长度就不会干死∏了。

MR_PP

morpheus126 发表于 2024-8-15 10:05
请教一下，抬头的API定义是不是要加上#IF VBA7 THEN...

1. #If VBA7 Then
   
2.     ' 64位和32位兼容的声明
   
3.     Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
   
4. #Else
   
5.     ' 仅32位的声明
   
6.     Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
   
7. #End If
   
8. 
   
9. Sub test()   '//数组部分复制
   
10.     Dim arr, brr, i&, j&
    
11.     arr = [a1:d30]
    
12.     ReDim brr(1 To 20, 1 To 2)
    
13.     '取第2~3列的第11~20行数据给brr数组
    
14.    
    
15.     sArch = LCase(Environ("PROCESSOR_ARCHITECTURE"))
    
16.     If sArch = "amd64" Then     ' 对于64位Office，检查PROCESSOR_ARCHITECTURE是否为amd64
    
17.         num = 24
    
18.     ElseIf sArch = "x86" Then   ' 对于32位Office，检查PROCESSOR_ARCHITECTURE是否为x86
    
19.         num = 16
    
20.     End If
    
21.    
    
22.     For i = 1 To 2
    
23.         CopyMemory brr(1, i), arr(11, i + 1), 20 * num '单元格数组每个元素占24个字节
    
24.     Next i
    
25.     [f1].Resize(20, 2) = brr
    
26. End Sub
    

复制代码

q3698995

有没有高人把这个封装成一个自定义函数造福人类

大灰狼1976

1. Sub test_2()
   
2. '一维数组转为二维
   
3. Dim arr(9) As Byte, brr(1 To 5, 1 To 2) As Byte, i&
   
4. For i = 0 To 9
   
5.   arr(i) = i
   
6. Next i
   
7. CopyMemory brr(1, 1), arr(0), 10 '到这里没问题
   
8. '[i1].Resize(5, 2) = brr ' byte数组好像不能直接输出到单元格区域
   
9. End Sub

复制代码