VBA每日一练（18），数组array的用法 redim preserve等

 

定义方式
dim  arr11 (5)
dim  arr12 (0 to 5 )
dim  arr13 (1 to 5)

dim arr21(1,5)
dim arr22(0 to 1 ,0 to 5)
dim arr22(1 to 1 ,1 to 5)

dim arr3()

静态数组
dim  arr51(5)

动态数组
dim arr61()
redim arr61(13)
redim arr61(20)
redim arr61(j)
redim arr61(1 to k)

dim arr71()
redim preserve  arr71( 1 to 10)

dim arr81()
arr81(0)=1
redim preserve  arr81( 1 to 10)

dim arr91()
arr91(1)=2
redim preserve  arr91( 1 to 10)
 

 

数组的定义方式的差别

• Dim arr1 As Range         '定义为excel对象，arr1是对象名。range是EXCEL的对象，cells也是
•                                         '并且这样的数组一定是 2维数组
• Dim arr2                          '定义变量，arr2是变量名
•                                         '变量最灵活，变量可以被 对象赋值，也可以被数组直接赋值  
• Dim arr3()                        '定义为数组，arr3是数组名
•                                         '而且这是动态数组，index默认了从0开始
•                                         ' 动态数组才配合用 redim ,静态数组不需要
•                                         ' 动态数组只能改变最后1个维度
• dim  arr4(5)                      '这是静态数组，静态数组不需要redim

 

数组定义与数组个数

• dim arr1(5)                                        'index是 0,1,2,3,4,5，共6个index
• dim arr1(1 to 5)                                 'index是 1,2,3,4,5，共5个index
• option base 2   dim arr1(5)               'index是 2,3,4,5，共4个index

 

什么时候用redim 和 preserve

• 数组先被定义为了 动态数组 dim arr1()
• 后面可以重新定义 redim arr1(k)
• 可以进行多次redim
• 如果下次redim想 保留之前 arr1里的数据，则需要写 redim preserve arr1(k) 
• 容易出错的地方 redim preserve arr1(1 to k）往往会报错，越界，因为之前index从0开始，无法匹配preserve
• 代码中使用了ReDim Preserve语句，出现类型不匹配？ 多半是因为在声明变量时写成了arr，而非arr()

举例子

• 如果要用 redim perserve arr1() ，那需要arr1先别定义为动态数组 dim arr1(), 只是定义为变量时不行的 dim arr1
• 实际上这段代码不需要preserve！！用来语法举例，

Sub ponyma_array2()
Dim arr1()  '当数组定义，且默认开始的index为0！ preserve时需要有0的index
'dim arr1 当变量定义

'Application.WorksheetFunction.CountA (Range("c:c"))
'Debug.Print Application.WorksheetFunction.CountA("c:c")
'这种counta只会把"a:a"当成1个字符串,不知道是对象1列，只会统计出1

   k = 1
   m = 1
   
   ReDim  preserve arr1(0 To Application.WorksheetFunction.CountA(Range("c:c")))
' 下标越界  ReDim  preserve arr1(1 To Application.WorksheetFunction.CountA(Range("c:c")))
      
'   Debug.Print Application.WorksheetFunction.CountA(Range("c:c"))
'   Debug.Print Range("c65536").End(xlUp).Row

   For i = 1 To Range("c65536").End(xlUp).Row Step 1
       If Cells(i, 3) <> "" Then
     
          Debug.Print Cells(i, 3)
          arr1(k) = Cells(i, 3)
          Debug.Print arr1(k)
          k = k + 1
'          Debug.Print arr1(k),写在这里问题1：k已经变了，下一个k还没赋值为空，2最后的k越界
'          循环是很精巧的，放的地方很讲究，放得不对，就错误百出
         
       End If
   Next i
   
   For j = 1 To UBound(arr1, 1)
       Cells(m, 10) = arr1(j)
       m = m + 1
   Next j

End Sub

 

数组的边界

• 一维数组边界
• lbound (arr1,1)  或 lbound (arr1)     下边界
• ubound(arr1,1)  或 ubound(arr1)     上边界
•  
•  
• 二维数组边界
• lbound(arr1,1)          第1维的下边界，excel里的最小行数
• ubound(arr1,1)         第1维的上边界，excel里的最大行数
• lbound(arr1,2)          第2维的下边界，excel里的最小列数
• ubound(arr1,2)         第2维的上边界，excel里的最大行数

 

数组的赋值

 

 

 

 

 

https://blog.csdn.net/weixin_42832348/article/details/81430634

 

https://zhidao.baidu.com/question/525808449407658485.html

 

如果要保留值改变数组的大小，只能修改数组的最后一维大小。
类型不匹配是因为re没有声明，你改成dim re()

http://www.excelpx.com/thread-322210-1-1.html

1. Sub aa()
2.     Dim arr, x, aa, bb, xx, cc, d, s
3.     Dim re()  '下面需要重新定义数组，所以开始要先定义re为一个数组
4.     arr3 = Range("x5").CurrentRegion.Value
5.     'x5 的区域都是非空数值
6.     ReDim re(1 To UBound(arr3) * 8, 1 To 1) '因为重新定义了数组，所以数组是空的
7.     '如果重新定义前，数组赋值过，REDIM 后也会把数组清空的
8.     '如果数组赋值过，REDIM 时还要保留源数据，需要加上 Preserve关键字
9.     '写法  ReDim Preserve re(1 To UBound(arr3) * 8, 1 To 1)
10.     '新数组re赋值，可以使用循环的方法进行赋值
11.    
12.     MsgBox re(6, 1)
13.     For i = 1 To UBound(arr3)
14.         For ii = 1 To 8
15.             Cells(i, ii) = re(i, 1)
16.         Next
17.     Next
18. End Sub

 

VBA只能动态修改数组最后一维的大小

Sub text() Dim arr(), i As Integer, j As Integer Dim brr i = Sheet2.Range("k65536").End(xlUp).Row brr = Sheet2.Range("a1:k" & i)   For i = 2 To UBound(brr)     If brr(i, 11) = 2 Then         j = j + 1         ReDim Preserve arr(1 To 11, 1 To j)         For r = 1 To 11             arr(r, j) = brr(i, r)         Next     End If Next Sheets("表2").Range("a18").Resize(UBound(arr, 2), UBound(arr)) = Application.Transpose(arr) End Sub

 

dim arr(1 to 3 ) as string

dim arr() as variant

 

 

redim arr(1)

arr=Array("a","b","c")

 

动态数组

k=0

redim arr(1 to k) 

k=k+1

 

 

 

Sub jackma101()
'尝试每个txt导入为1行，或1个sheet----往数组里append 不会！，只会用cells()=存起来文件名

x1 = input_files1("C:\Users\Administrator\Desktop\test1", "\*.txt")
'x1 = input_files1("C:\Users\Administrator\Desktop", "\*.txt")
'debug.print input_files1("C:\Users\Administrator\Desktop", "\*.txt")


End Sub



Function input_files1(PATH1, PATH2)
'取文件数量
'取文件名
Dim arr1()


k = 0
file1 = Dir(PATH1 & PATH2)
Debug.Print file1
arr1(k) = file1


Do Until Len(file1) = 0


   file1 = Dir
   k = k + 1
   arr1(k) = file1
      
   Debug.Print file1
   Debug.Print k
   
Loop

Debug.Print "sum= " & k

End Function

 

数组里辅助了

取出来为啥是空？

Sub jackma101()
'尝试每个txt导入为1行，或1个sheet

x1 = input_files1("C:\Users\Administrator\Desktop\test1", "\*.txt")
'x1 = input_files1("C:\Users\Administrator\Desktop", "\*.txt")
'debug.print input_files1("C:\Users\Administrator\Desktop", "\*.txt")








End Sub

Function input_files1(PATH1, PATH2)
'取文件数量
'取文件名
Dim arr1()


file1 = Dir(PATH1 & PATH2)
k = 0

Debug.Print file1
Debug.Print k


Do Until Len(file1) = 0
   file1 = Dir
   k = k + 1

    ReDim arr1(1 To k)
    arr1(k) = file1
    
   Debug.Print "arr(K)=" & arr1(k)
   Debug.Print file1
   Debug.Print k

Loop
Debug.Print "sum= " & k



For i = LBound(arr1, 1) To UBound(arr1, 1)
    Debug.Print arr1(i) & "?"
Next i


End Function

 

Sub jackma101()
'尝试每个txt导入为1行，或1个sheet

x1 = input_files1("C:\Users\Administrator\Desktop\test1", "\*.txt")
'x1 = input_files1("C:\Users\Administrator\Desktop", "\*.txt")
'debug.print input_files1("C:\Users\Administrator\Desktop", "\*.txt")








End Sub

Function input_files1(PATH1, PATH2)
'取文件数量
'取文件名
Dim arr1()


file1 = Dir(PATH1 & PATH2)
k = 0

Debug.Print file1
Debug.Print k


Do Until Len(file1) = 0
   file1 = Dir
   k = k + 1

    ReDim Preserve arr1(1 To k)
    arr1(k) = file1
    
   Debug.Print "arr(K)=" & arr1(k)
   Debug.Print file1
   Debug.Print k

Loop
Debug.Print "sum= " & k



For i = LBound(arr1, 1) To UBound(arr1, 1)
    Debug.Print arr1(i) & "?"
Next i


End Function

 

 

Sub jackma101()
'尝试每个txt导入为1行，或1个sheet

x1 = input_files1("C:\Users\Administrator\Desktop\test1", "\*.txt")
'x1 = input_files1("C:\Users\Administrator\Desktop", "\*.txt")
'debug.print input_files1("C:\Users\Administrator\Desktop", "\*.txt")


End Sub

Function input_files1(PATH1, PATH2)
'取文件数量
'取文件名
Dim arr1()


file1 = Dir(PATH1 & PATH2)
k = 0

ReDim arr1(1)
arr1(0) = file1


Do Until Len(file1) = 0
   file1 = Dir
   k = k + 1

    ReDim Preserve arr1(0 To k)
    arr1(k) = file1
    Debug.Print "arr(K)=" & arr1(k)

Loop
Debug.Print "sum= " & k





For i = LBound(arr1, 1) To UBound(arr1, 1)
    Debug.Print arr1(i)
    
    Open PATH1 & "\" & arr1(i) For Input As #1
    Input #1, str1

'    ActiveSheet.Cells(i, 1).Value = arr1(i)
'    ActiveSheet.Cells(i, 2).Value = str1
    Close #1
    
    
Next i

3.3 先写入数组array中，再写到其他地方，据说这样能大幅提高速度！

把需要的筛选的数据，存在数据，然后从数组写到需要的地方，这是个好习惯

第1版

Sub 删除空格4()
Dim arr1()


ReDim arr1(11)                      '必须重新定义，现在不太理解
j = 0                               'j=1开始就会越界
For i = 1 To 11 Step 1
   If Not IsEmpty(Cells(i, 1)) Then
      arr1(j) = Cells(i, 1)
      j = j + 1
   End If
Next i


For j = 0 To UBound(arr1())
    Cells(j + 1, 9) = arr1(j)      '单元格得从1开始，arr()得从0开始
Next j


End Sub

第2版重写

• 要注意的问题
• 1 定义数组arr1() 实际已经定义了index为0
• 2 现在还不明白为啥这次redim 需要加 preseve?
• 3 使用VBA函数，如countA时，不能像在EXCEL表公式里  countA("c:c") 这是countA  一个字符串
• 必须用 countA(range("c:c"))  这才表示引用的excel对象
• debug.print用来监测的时候，需要注意，放在循环的位置，尤其是在k=K+1这种变化时，和放在哪个for循环之内外！

Sub ponyma_array2()
Dim arr1()  '当数组定义，且默认开始的index为0！ preserve时需要有0的index
'dim arr1 当变量定义


k = 1
m = 1

'Application.WorksheetFunction.CountA (Range("c:c"))
'Debug.Print Application.WorksheetFunction.CountA("c:c")
'这种counta只会把"a:a"当成1个字符串,不知道是对象1列，只会统计出1


ReDim Preserve arr1(0 To Application.WorksheetFunction.CountA(Range("c:c")))
' 下标越界  ReDim Preserve arr1(1 To Application.WorksheetFunction.CountA(Range("c:c")))


   For i = 1 To Range("c65536").End(xlUp).Row Step 1
       If Cells(i, 3) <> "" Then
     
          Debug.Print Cells(i, 3)
          arr1(k) = Cells(i, 3)
          Debug.Print arr1(k)
          k = k + 1
'          Debug.Print arr1(k),写在这里问题1：k已经变了，下一个k还没赋值为空，2最后的k越界
'          循环是很精巧的，放的地方很讲究，放得不对，就错误百出
         
       End If
   Next i
   
   For j = 1 To UBound(arr1, 1)
       Cells(m, 10) = arr1(j)
       m = m + 1
   Next j

End Sub

第3版

Option Explicit

Sub ponyma1()


Dim arr1()
Dim k1, k2, k
Dim i, j
k1 = WorksheetFunction.CountA(Range("a:a"))
k2 = Range("a65536").End(xlUp).Row
Debug.Print "这列非空数据个数k1=" & k1
Debug.Print "这列最后1个有数据的行数k2=" & k2


'arr1(0) = 1
'ReDim Preserve arr1(1, k)
'这样会越界，因为你需要preserve数据。但是index系不符合
'但是，如果不preserve 就无所谓
'或者虽然 dim arr1() 是动态数据从index0开始，但是arr1()一直为空,preserve也不会出现index越界问题

ReDim Preserve arr1(1 To k1)
'ReDim Preserve arr1(1, k1) 这样就会越界。。。因为语法是2维数组了！
'ReDim Preserve arr1(1 to k1) 这样就对的

k = 1
For i = 1 To k2
   If Cells(i, 1) <> "" Then
      arr1(k) = Cells(i, 1)
      Debug.Print arr1(k)
      k = k + 1
   End If
Next i