[已解决]数组给不连续的单元格赋值只能一个一个地写吗

dpdmlym

不连续的单元格赋值给数组.rar (11.46 KB, 下载次数: 48)

2012-1-5 21:04 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

sunjing-zxl

2012-1-5 21:52

1. Private arr2
   
2. Sub aa()
   
3.     Dim arr1, arr3()
   
4.     Dim i As Long, j As Long
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.     arr1 = Range("C5:H11")    '蓝色区域赋值给数组
   
7.     arr2 = Range("B13:G17")    '红色区域赋值给数组
   
8.     ReDim arr3(1 To UBound(arr2, 1), 1 To UBound(arr2, 2))
   
9.     For i = 1 To UBound(arr1, 1)    '在蓝色区域数组行循环
   
10.         For j = 1 To UBound(arr1, 2)    '在蓝色区域数组列循环
    
11.             If arr1(i, j) <> "" Then
    
12.                 d(arr1(i, j)) = arr1(i + 1, j)
    
13.                 arr1(i + 1, j) = ""
    
14.             End If
    
15.         Next j
    
16.     Next i
    
17.     For i = 1 To UBound(arr2, 1)    '在红色区域数组行循环
    
18.         For j = 1 To UBound(arr2, 2)    '在红色区域数组列循环
    
19.             If arr2(i, j) <> "" Then
    
20.                 arr3(i, j) = arr2(i, j)
    
21.                 arr3(i + 1, j) = d(arr2(i, j))
    
22.             End If
    
23.         Next j
    
24.     Next i
    
25.     Range("B13").Resize(UBound(arr3, 1), UBound(arr3, 2)) = arr3
    
26. End Sub
    
27. Sub qk()
    
28.     Range("B13").Resize(UBound(arr2, 1), UBound(arr2, 2)) = arr2
    
29. End Sub
    
30. 
    

复制代码

注意：复制之后可以清空，但是不能连续点击两次复制，否则程序出错，而且无法完成清空
附件： 不连续的单元格赋值给数组-sunjing.rar (12.96 KB, 下载次数: 87)

2012-1-5 21:52 上传

点击文件名下载附件

跳转到最佳答案楼层

sunjing-zxl

1. Private arr2
   
2. Sub aa()
   
3.     Dim arr1, arr3()
   
4.     Dim i As Long, j As Long
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.     arr1 = Range("C5:H11")    '蓝色区域赋值给数组
   
7.     arr2 = Range("B13:G17")    '红色区域赋值给数组
   
8.     ReDim arr3(1 To UBound(arr2, 1), 1 To UBound(arr2, 2))
   
9.     For i = 1 To UBound(arr1, 1)    '在蓝色区域数组行循环
   
10.         For j = 1 To UBound(arr1, 2)    '在蓝色区域数组列循环
    
11.             If arr1(i, j) <> "" Then
    
12.                 d(arr1(i, j)) = arr1(i + 1, j)
    
13.                 arr1(i + 1, j) = ""
    
14.             End If
    
15.         Next j
    
16.     Next i
    
17.     For i = 1 To UBound(arr2, 1)    '在红色区域数组行循环
    
18.         For j = 1 To UBound(arr2, 2)    '在红色区域数组列循环
    
19.             If arr2(i, j) <> "" Then
    
20.                 arr3(i, j) = arr2(i, j)
    
21.                 arr3(i + 1, j) = d(arr2(i, j))
    
22.             End If
    
23.         Next j
    
24.     Next i
    
25.     Range("B13").Resize(UBound(arr3, 1), UBound(arr3, 2)) = arr3
    
26. End Sub
    
27. Sub qk()
    
28.     Range("B13").Resize(UBound(arr2, 1), UBound(arr2, 2)) = arr2
    
29. End Sub
    
30. 
    

复制代码

注意：复制之后可以清空，但是不能连续点击两次复制，否则程序出错，而且无法完成清空
附件： 不连续的单元格赋值给数组-sunjing.rar (12.96 KB, 下载次数: 87)

2012-1-5 21:52 上传

点击文件名下载附件

dpdmlym

这样解决行吗？用定义区域名称的方法。

zscty

是个不错的想法，学习了，谢谢！！！