VBA&动态定义数组
Dim & a() & As &
ReDim & a(100)
保留动态数组的内容&
每次执行 & ReDim &
语句时，当前存储在数组中的值都会全部丢失。Visual & Basi
& 重新将数组元素的值置为 & Empty（对
& Variant & 数组）、置为
& 0（对 & Numeric
& 数组）、置为 & 零长度字符串（对
& String & 数组）或者置为
Nothing（对于对象的数组）。&
在为新数据准备数组，或者要缩减数组大小以节省内存时，这样做是非常有用的。有时希望改变数组大小又不丢失数组中的数据。使用具有
& Preserve & 关键字的
& ReDim & 语句就可做到这点。例如，使用
& UBound &
函数引用上界，使数组扩大、增加一个元素，而现有元素的值并未丢失：&
ReDim & Preserve & DynArray
& (UBound & (DynArray)
在用 & Preserve &
关键字时，只能改变多维数组中最后一维的上界；如果改变了其它维或最后一维的下界，那么运行时就会出错。所以可这样编程：&
ReDim & Preserve & Matrix
& (10, & UBound
& (Matrix, & 2)
而不可这样编程：&
ReDim & Preserve & Matrix
& (UBound & (Matrix,
& 1) & + & 1,
已投稿到：
以上网友发言只代表其个人观点，不代表新浪网的观点或立场。32、[VBA入门到放弃笔记] 动态的数组 - 简书
32、[VBA入门到放弃笔记] 动态的数组
动态的数组事先是没有设置大小的。
定义动态的数组首先要声明，Dim arr()，然后用Redim命令来设置数组的大小。
Dim arr(), i As Long
ReDim arr(1 To 10)'设置数组大小，一维数组，10个元素。
For i = 1 To 10
arr(i) = i
Range("a1").Resize(UBound(arr), 1) = Application.Transpose(arr)
Dim arr(), i As Long
ReDim arr(1 To 10, 1 To 2) '设定数组大小
For i = 1 To 10
arr(i, 1) = i
arr(i, 2) = i * 100
Range("a1").Resize(UBound(arr), 2) = arr
数组的扩展
Redim Preserve
Dim arr(), i As Long
For i = 1 To 10
ReDim Preserve arr(1 To i)
arr(i) = i
Range("a1").Resize(UBound(arr), 1) = Application.Transpose(arr)
当i=1，arr（1 to 1），arr(1)=1
当i=2，arr（1 to 2）,arr(1)=1,arr(2)=2
......如此类推
Paste_Image.png
ReDim Preserve每次扩展数组的时候，都会保留前面的数据，如i=2时，并不会删除arr(1)这个元素的数据,类似滚雪球，越滚越大。
Redim和ReDim Preserve的区别是：Redim是清空数组，再设置数组大小，并不保留原有的数据，ReDim Preserve是保留原有数据，扩张‘地盘‘。
Dim arr(), i As Long
For i = 1 To 10
ReDim arr(1 To i)
arr(i) = i
Range("a1").Resize(UBound(arr), 1) = Application.Transpose(arr)
二维数组的扩展只能扩展其第二维，要将上的代码cc改为二维数组，如下
Dim arr(), i As Long
For i = 1 To 10
ReDim Preserve arr(1 To 1, 1 To i)
arr(1, i) = i
Range("a1").Resize(UBound(arr, 2), 1) = Application.Transpose(arr)
先将二维数组设定为【1行 i 列】的数组，然后转置为 【 i 行1列 】的数值输出到单元格。
Application.Transpose的局限
当数据量比较少的时候，Application.Transpose能将数据都转置。
当数据量超过65536行，或254列时，会超出Application.Transpose的极限，出问题。
Application.Transpose效率较低。
如下面代码及其运行结果（图片）
Dim arr(), i As Long
ReDim arr(1 To 65537)
For i = 1 To UBound(arr)
arr(i) = i
Range("a1").Resize(UBound(arr), 1) = Application.Transpose(arr)
处理方法：
1、声明一个足够大的空数组，往里面填装数据。比如，预计数据条数有1000条（不确定），那么就声明一个10000行N列的二维数组，然后用计数器计算条数，假如有K条，则将数组在K行这个地方一刀切开两端，将有数据的一端输出到工作表。
2、这种方法往往比redim preserve更方便和容易理解，也更有效率。
3、当然，实际情况下，可灵活结合使用。
【练习】提取销售额大于等于500的部门。
1 Redim Presever写法
Dim arr, brr()
arr = Range("a1").CurrentRegion
For i = 2 To UBound(arr)
If arr(i, 2) &= 500 Then
ReDim Preserve brr(1 To 2, 1 To k) '2行K列的数组
brr(1, k) = arr(i, 1) '提取符合条件的数据，这是部门
brr(2, k) = arr(i, 2) '销售额
Range("g1").Resize(2, k) = brr '未转置前的数据（数组brr原来的样子)
Range("d2").Resize(k, 2) = Application.Transpose(brr) '转置后的数据
Paste_Image.png
range("g1:o2")区域转置后的样子，可以手工操作: 复制--转置
Paste_Image.png
2 声明一个足够大的数组写法
Dim arr, brr()
arr = Range("a1").CurrentRegion
'设置brr和arr一样大小,因为是提取数据操作，数据条数不可能超过arr的条数
ReDim brr(1 To UBound(arr), 1 To 2)
For i = 2 To UBound(arr)
If arr(i, 2) &= 500 Then
'提取符合条件的数据放到数组brr
brr(k, 1) = arr(i, 1) '提取符合条件的数据，这是部门
brr(k, 2) = arr(i, 2) '销售额
Range("d2").Resize(k, 2) = brr '直接输出数据
Paste_Image.png
数组arr和brr一样大小，从arr中提取符合条件的数据，遍历的时候，发现1条就计数1条，第1条数据放在brr第一行，第2条数据放在brr第2行，第3条数据放在brr第3行.....依次操作，直到完毕。
然后用计数的变量K值来截取brr的条目数，放到工作表中。见代码中的 Resize(k, 2)。
这种方式比ReDim Preserve省事有效。
定义数组的时候，数组开始是没有数据的，我们需要将数据放进数组，然后进行操作。 操作数组，一般遵从这样的流程。数组赋值，将数据放进数组。操作数组，处理数据，获得想要的结果。将结果输出到工作表。 这样看起来比直接操作工作表麻烦，但实际上比直接操作工作表要快很多很多。 数组的赋值...
一维数组的数据不能直接输出到单元格，需要转置才能输出到单元格，使用Application.Transpose函数。 一维数组转置后就会变成二维数组，然后可以直接输出到单元格。如上图辅助的brr数组，就是arr转置后的结果。 一维数组可以直接输出在一行当中，如下图 如果要输出...
背景 一年多以前我在知乎上答了有关LeetCode的问题, 分享了一些自己做题目的经验。 张土汪：刷leetcode是什么样的体验？ 慢慢有一些赞和感谢, 备受鼓舞, 于是我把所做过的题目用一个script跑了一下，编辑成一篇文章。这个总结页面是这么规划的： 题目名称(答案...
函数可以应用于数组，不需要进行循环。 一 函数在数组中的应用 1.1 数组的最值 Sub s() Dim arr1() arr1 = Array(1, 12, 4, 5, 19) MsgBox &1,12,4,5,19最大值& & Application.Max(arr1)...
1 数组旳大小 Lbound(数组）可以获取数组的最小下标 Ubound（数组）可以获取数组的最大上标 Ubound（数组，1）可以获取数组的行方面最大上标 Ubound（数组，2）可以获取数组的列方向最大上标 2 动态数组的动态扩充 2.1一维数组的扩充 如果一个数组无法...
SQLite概述 简介SQLite是用C语言编写的开源嵌入式数据库引擎，它支持大多数的SQL92标准，并且可以在所有主要的操作系统上运行，支持绝大多数操作语句。 为什么创建数据库？大量的类似结构的数据，要增删改查。 SQLite主要特点 SQLite支持的数据类型 动态数据...
一个人的平安夜 很平安 女儿拿到圣诞礼物 HAPPY去了 一个人 在家看电影 看《消失的凶手》 也没认真看 没看懂也瞎看 上自媒体 回答无聊的问题 瓜子嗑完了 喝茶
艾若 平安夜 圣诞夜唱圣诞歌，这是古老的传统；据不完全统计，全世界有记载的圣诞歌约有上...
《爱情与友谊》一听便知是来自简奥斯汀的改编剧，和此前的《傲慢与偏见》、《理智与情感》等剧在名字上一气呵成。故事讲述的是，一个爱慕虚荣的上层社会寡妇Lady Susan兜兜转转终为自己和女儿寻找到如意郎君的故事。 没错，“为姑娘们的婚嫁操碎了心”，这样的剧情非常的简奥斯汀。但...
看过1月26日军旗猎猎推送的文章“军嫂心声：我可能结了场假婚”，同样身为军嫂的我，感同身受。但是看过文后的评论，却久久不能平静。 一、军人和农民工同样值得尊重。很多人留言说，农民工家庭也是这样两地分居，一年到头只能回家一次，女人要照顾老人和孩子，十分不易。随即就有人来批判，...
现在很多人都在说走出舒适区，都在尝试各种新鲜的东西。可是我们什么时候能走出舒适区，哪个阶段我们要去走出舒适区呢？我想那就是把我们的舒适区变得更舒适，变得更豪华。当我们在一个领域取得一点成绩了，我们就觉得这个领域让我太舒适了，我们要跳出去，接受新的东西的刺激。这样的想法我想很...VBA中如何动态定义数组 - jenney.qiu - 博客园
利用&dim&Arr（）as&string这样声明，一旦赋值后，数组大小也就固定了。如果要改变数组大小，要用redim&命令redim&arr（10）
加preserve&可以不清空数组，保持原有数据&preserve&redim&arr（）查看: 3005|回复: 7
如何动态赋值数组啊for each 语句
阅读权限20
在线时间 小时
&&各位大侠，小弟工作中遇到一个问题，特请教！
& && &小弟想用for each 语句读取指定文件夹下的所有excel文件名称到一个数组函数里面，请问如何操作？读到数组里面的文件名如何排序？默认是啥顺序？
关键是底下部分循环myfiles里面的ofiles名称，怎么读取到arr()数组里面？
&&dim arr()&&
for each ofile in myfiles
& && & 中间该怎么写啊？
阅读权限30
在线时间 小时
本帖最后由 老谭酸菜 于
18:50 编辑
按文件名的第一个字符简单的排了下序：
Sub 输出Excel文件列表()
& & Dim arr
& & '取MsExcel文件名到数组arr()
& & arr = 取Excel文件列表(&D:\Excel文件&)& && && && & '列出文件夹“D:\Excel文件”下的MsExcel文件
& &
& & '输出到活动工作表的第一列:
& & Columns(&A&).ClearContents
& & [A1].Resize(UBound(arr) + 1, 1) = Application.Transpose(arr)
& & Columns(&A&).AutoFit
End Sub
Function 取Excel文件列表(str As String)
& & Dim arr1(), arr2(), arr3(), fs, myfiles, ofile, n, m, temp
& &
& & Set fs = CreateObject(&scripting.filesystemobject&)
& & Set myfiles = fs.getfolder(str)
& &
& & '取MsExcel文件名到数组arr1()
& & n = 0
& & For Each ofile In myfiles.Files
& && &&&If InStr(&,xls,xlsm,xlsb,xlsx,xlt,xltx,xltm,csv,prn,xlk,dif,xla,xlam,slk,&, LCase(fs.GetExtensionName(ofile.Name))) & 0 Then
& && && && &ReDim Preserve arr1(n)
& && && && &arr1(n) = ofile.Name
& && && && &n = n + 1
& && &&&End If
& & Next
& &
& & '按文件名的第一个字符排序
& & m = 1
& & Do While True
& && &&&ReDim arr2(1, n - 1)
& && &&&For i = 0 To n - 1
& && && && &arr2(0, i) = Asc(LCase(Mid(arr1(i), m, 1)))
& && && && &arr2(1, i) = i
& && && && &
& && &&&Next i
& &
& && &&&For i = 0 To n - 2
& && && && &For ii = i + 1 To n - 1
& && && && && & If arr2(0, ii) & arr2(0, i) Then
& && && && && && &&&temp = arr2(0, i)
& && && && && && &&&arr2(0, i) = arr2(0, ii)
& && && && && && &&&arr2(0, ii) = temp
& && && && && && &&&temp = arr2(1, i)
& && && && && && &&&arr2(1, i) = arr2(1, ii)
& && && && && && &&&arr2(1, ii) = temp
& && && && && & End If
& && && && &Next ii
& && &&&Next i
& && &&&
& && &&&
& && &&&
& && &&&m = m + 1
& && &&&Exit Do
& & Loop
& &
& & ReDim arr3(n - 1)
& & For i = 0 To n - 1
& && &&&arr3(i) = arr1(arr2(1, i))
& & Next i
& &
& & 取Excel文件列表 = arr3
End Function
阅读权限95
在线时间 小时
本帖最后由 香川群子 于
20:46 编辑
老谭酸菜 发表于
感谢群子指教！人家指明了要用“For Each ..... Next”，太复杂了俺做不来。
呵呵，指明了要用 For Each 循环……
还能这么贴心么……
我来一个简单一些的，一边读取文件名，一边进行比较排序。Sub 输出文件名并排序()
& & Dim i&, n&, fnm$
& & tms = Timer
& & myPath$ = ThisWorkbook.Path
& &
& & Set fs = CreateObject(&Scripting.FileSystemObject&)
& & Set myfiles = fs.GetFolder(myPath)
& &
& & n = myfiles.Files.Count
& & ReDim arr$(n)
& &
& & n = 0
& & For Each ofile In myfiles.Files
& && &&&fnm = ofile.Name
& && &&&If fnm Like &*.xl*& Then
& && && && &For i = n To 1 Step -1
& && && && && & If arr(i - 1) & fnm Then
& && && && && && &&&arr(i) = arr(i - 1)
& && && && && & Else
& && && && && && &&&Exit For
& && && && && & End If
& && && && &Next
& && && && &arr(i) = fnm
& && && && &n = n + 1
& && &&&End If
& & Next
& &
& & [a1].Resize(n) = Application.Transpose(arr)
& & Columns(&A&).AutoFit
& & MsgBox Format(Timer - tms, &0.000s&)
End Sub复制代码
阅读权限30
在线时间 小时
本帖最后由 老谭酸菜 于
22:03 编辑
{:soso_e179:}群子做起算法来得心应手啊！时间也珍惜到了毫秒！学习了。
顺便挑个刺：
fnm Like &*.xl*&&&这样处理太草率了点吧？万一是“.xly”、“.xls.xly”之类的呢？EXCEL目前还不支持啊。{:soso_e120:}
阅读权限30
在线时间 小时
本帖最后由 老谭酸菜 于
17:57 编辑
感谢群子指教！人家指明了要用“For Each ..... Next”，太复杂了俺做不来。{:soso_e113:}
阅读权限95
在线时间 小时
用Dir命令，进行Do……Loop循环也可以做到。
另外，如果还有子文件夹，那么3楼方法需要改为递归，而dir需要进行深层搜索。
搜素【遍历文件夹】可以找到很多帖子作参考。
阅读权限20
在线时间 小时
谢谢2楼和三楼的版主分帮忙啊！
阅读权限100
在线时间 小时
建议上传表格附件来说明问题。
最新热点 /1
这一次不要再错过了，ExcelHome部分畅销图书5折封顶。左手春天，右手书卷，用好书激活你的职场力。抢购时间，即日起至3月26日。
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师