VBA将这段代码改成数组并且不用copy语句

laoau138

VBA将这段代码改成数组并且不用copy语句

砂海

Option Explicit '''要求强制声明变量
Option Base 1 '''系统默认 为 0 ,故为 0 不写

Sub test()

dim 数据源 , i&,j&
dim 吉林( 1 to 10000 , 1 to 2) , 黑龙( 1 to 10000 , 1 to 2)

数据源 = ThisWorkbook.Sheets("sheet1").Range("a1:b" & ThisWorkbook.Sheets("sheet1").Range("a65536").End(xlUp)).value

'循环计算 生成 各省份 的 数组

省份 循环
ThisWorkbook.Sheets("吉林").Range("a1").resize(行数 , 2).value = 吉林
省份 循环 结束

end sub

laoau138

砂海 发表于 2016-10-1 09:19
Option Explicit '''要求强制声明变量
Option Base 1 '''系统默认 为 0 ,故为 0 不写

不知道你在写什么

砂海

Option Explicit '''要求强制声明变量
Option Base 1 '''系统默认 为 0 ,故为 0 不写

------------------------------------------------------------
以上写在 模块 顶部 ,程序之外 , 不一定必须

其余是 示例 ,
思路 是 把 单元格循环 改为 数组循环

today0427

1. Sub gx()
   
2.     Dim arr, brr(), i&, j%, s, n&
   
3.     arr = Sheets("sheet1").[a1].CurrentRegion
   
4.     For Each s In Sheets
   
5.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
6.         If s.Name <> "Sheet1" Then
   
7.             s.UsedRange.Clear
   
8.             For i = 1 To UBound(arr)
   
9.                 If i = 1 Or arr(i, 2) Like "*" & s.Name & "*" Then
   
10.                 n = n + 1
    
11.                     For j = 1 To UBound(arr, 2)
    
12.                     brr(n, j) = arr(i, j)
    
13.                     Next
    
14.                 End If
    
15.             Next
    
16.         s.[a1].Resize(n, j - 1) = brr
    
17.         Erase brr: n = 0
    
18.         End If
    
19.     Next
    
20. End Sub
    
21. 
    

复制代码

laoau138

today0427 发表于 2016-10-2 22:45

何解会有2个

today0427

我也不知道，附件老弄不好