注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

零售创新,创新那些事儿,SPSS,VBA

零售创新

 
 
 

日志

 
 
关于我

新浪微博,零售创新 研究经理,数据分析师 希望和市场研究和零售业的同事共同进步! 本博客发表的都是免费或试用的资料,如果有版权问题请发邮件wangli12a@163.com联系删除。 spss excel vba blog

网易考拉推荐

VBA数组学习笔记(转)  

2012-03-31 16:55:17|  分类: VB和VBA知识 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |

VBA数组学习笔记(转)


一、数组的分类

按元素数目分:元素数目大小固定的数组和元素数目大小不固定的动态数组。

按维数分:一维数组、多维数组。

Arr(1 to 12)、Arr1(0 to 24)----一维固定数组;

Arr2(1 to 5,1 to 8)--------------- 二维固定数组;

Arr3(5 to 10,6 to 12,1 to 100) ---- 三维固定数组。

动态数组

Dim Arr2(),r%

r=r+1

ReDim Preserve Arr2(1 To r) ―――动态数组;可以重新声明(只有最后一维的数目才能重新声明);

用了关键字  Preserve  可确保原来包含数据的数组中的任何数据都不会丢失

二、数组的赋值

2.1,单元格区域保存到数组

arr = [e22:i24]

arr=Range(“e22:i24”)

2.2,Array函数

myArray = Array("AAA", "BBB", 200, 500, "2006-7-12")

如果代码头没有 Option Base 1 的语句,则数组myArray的上限为4,下限为0。

即下限LBound(myArr)=0 ,上限 UBound(myArr)=4

 二维数组的第一维的上限:UBound(Arr,1)

二维数组的第二维的上限:UBound(Arr,2)

多维数组上限的求法一样。

 2.3,把单元格区域公式赋给数组

如果a5=B4+1

arr = [a4:c8].Formula '将单元格绝对引用公式保存到数组

[e4:g8]=arr     此时e5中的公式也=B4+1;

如果将单元格相对引用公式保存到数组

arr = [a4:c8].FormulaR1C1

如果a5=B4+1

[e4:g8]=arr     此时e5中的公式就=E4+1;

 三、数组的处理

3.1,数组里的最大值和最小值

最大值aa = Application.WorksheetFunction.Max(Arr)

aa= Application.WorksheetFunction.Large(Arr,1)

最小值aa = Application.WorksheetFunction.Min(Arr)

aa= Application.WorksheetFunction.Small(Arr,1)

3.2,数组里搜索

Temp = Filter(Arr, xm(i)) '搜索数组

Sub yy()

Dim Arr(), aa$, x%

aa = "asssfffssssaaasss": bb = "s"

For x = 1 To Len(aa)

    ReDim Preserve Arr(1 To x)

    Arr(x) = Mid(aa, x, 1)

Next x

temp = Filter(Arr, bb)

cc = UBound(temp) + 1    ‘cc=”s”的个数

End Sub

用于对字符串数组进行搜索,得到一个新的数组temp,

缺点:只告诉你某元素是否存在于数组中,而不知道其具体位置;

 

数组精确搜索:

Sub FilterExactMatch()

   ' 该函数在一个字符串数组中搜索那些

   ' 与搜索字符串完全匹配的元素。

   Dim astrFilter() As String

   Dim astrTemp() As String

   Dim lngUpper As Long

   Dim lngLower As Long

   Dim lngIndex As Long

   Dim lngCount As Long

   astrItems = Array("a", "sas", "s", "Sas", "s", "f", "f", "f", "f", "sas", "s", "sas", "a", "a", "Sas", "s", "s")

   strSearch = "Sas"

   ' 为搜索字符串而过滤数组。

   astrFilter = Filter(astrItems, strSearch)

   ' 存储结果数组的上限和下限。

   lngUpper = UBound(astrFilter)

   lngLower = LBound(astrFilter)

   ' 将临时数组调整到相同大小。

   ReDim astrTemp(lngLower To lngUpper)

   ' 在经过滤的数组的每个元素中循环。

   For lngIndex = lngLower To lngUpper

      ' 检查该元素是否与搜索字符串完全匹配。

      If astrFilter(lngIndex) = strSearch Then

         ' 在另一个数组中存储完全匹配的元素。

         astrTemp(lngCount) = strSearch

         lngCount = lngCount + 1

      End If

   Next lngIndex

   ' 重新调整包含完全匹配的元素的数组的大小。

   ReDim Preserve astrTemp(lngLower To lngCount - 1)

   ' 返回包含完全匹配的元素的数组。

   [a5].Resize(1, UBound(astrTemp) + 1) = Application.Transpose(astrTemp)

End Sub


3.3,转置

取工作表区域的转置到数组:arr=Application.Transpose([a1:c5])  ‘此时arr是转置成3行5列的数组,arr(1 to 3,1 to 5)

[e1:i3]=arr   ‘此时3行5列。

数组间也可以转置:arr1=Application.Transpose(arr)

取数组arr的第n列赋值到某列区域:[e1:e5]=Application.Index(arr, 0, n)

也可写成 [e1:e5]=Application.Index(arr, , n)

赋值产生一个新数组:arr1=Application.Index(arr,0 , n)

取数组arr的第n行赋值到某行区域:[a6:c6]=Application.Index(arr,n ,0 )

也可写成 [a6:c6]=Application.Index(arr,n ) 省略0,也省略了“,“

赋值产生一个新数组:arr1=Application.Index(arr, n )

3.4,数组的比较(字典法)

题目:将A列中的数据与C列相比较,输出C列中没有的数据到D列:


Sub cc()

‘by:ccwan

    Dim arr, brr, i&, x&, d As Object

    arr = Range("a1:a" & [a65536].End(xlUp).Row)

    brr = Range("c1:c" & [c65536].End(xlUp).Row)

    Set d = CreateObject("scripting.dictionary")

    For i = 1 To UBound(arr)

        d(arr(i, 1)) = ""

    Next

    For x = 1 To UBound(brr)

        If d.exists(brr(x, 1)) Then

            d.Remove brr(x, 1)

        End If

    Next

    [d1].Resize(d.Count, 1) = Application.Transpose(d.keys)

End Sub


3.5,数组的排序

字符串数组不能用Large(Arr,i) 或者 Small(Arr,i) 来排序;

但数值数组可以;

一个很好的字典+数组排序的实例:

Sub yy1()

‘by:oobird


 Dim i%, c As Range, x, d As Object

Set d = CreateObject("Scripting.Dictionary")

For Each c In Sheet2.UsedRange

    If c.Value <> "" Then

        If Not d.exists(c.Value) Then

            d.Add c.Value, 1

        Else

            d(c.Value) = d(c.Value) + 1

        End If

    End If

Next

    k = d.keys: t = d.items    'k是各个不重复值,t是各个不重复值的个数

    ReDim x(1 To 2, 1 To d.Count)

 For i = 1 To d.Count

    x(2, i) = Application.Large(k, i)   ‘从大到小排序

    x(1, i) = d(x(2, i))

 Next i

 With Sheet1

    .[b2].Resize(2, i - 1) = x

    ReDim x(1 To 2, 1 To d.Count)

    For i = 1 To d.Count

        x(1, i) = Application.Max(t)   ‘从大到小排序

        w = Application.Match(x(1, i), t, 0) – 1    ‘查找此值在不重复值系列中的排位,因为w是从0开始的,所以-1


        x(2, i) = k(w)    ‘求得对应的不重复值

        t(w) = ""     ‘使前面的最大值为空,继续循环

    Next i

    .[b5].Resize(2, i - 1) = x    ‘两行一起赋值给B5开始的单元格

End With

End Sub

字符串数组的排序,可以使用辅助列,把数组各元素依次赋给单元格,然后对这些单元格运用Excel自有的数据排序功能进行排序,再把单元

格排过序的值重新赋给数组。

3.6,数组赋给单元格区域

r=Ubound(Arr)   r为一维数组的上限;

Range("a2").Resize(1, r) = Arr '填充到工作表的一行之中(Arr为一维数组)

或者写成 Range("a2").Resize(1, Ubound(Arr)) = Arr

 二维数组Arr(100,5)

Range(“a1”).Resize(100,5)=Arr

[a1:e100]=Arr

或者写成 Range("a1").Resize(Ubound(Arr,1), Ubound(Arr,2)) = Arr

'-----------------------------------------------------------------------------------------


赋值方面的补充:

Sub y()

Dim arr

arr = [mmult(row(1:100),column(a:f))]

[a1].Resize(100, 6) = arr

End Sub

Sub yy()

Dim arr

arr = [column(a:z)^3]

MsgBox Join(arr, ",")

arr = [transpose(row(1:222))]

MsgBox Join(arr, ",")

End Sub

Sub yyy()

Dim arr

arr = Split("a b c d e f g")

MsgBox Join(arr, ",")

End Sub

  评论这张
 
阅读(718)| 评论(0)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017