[数组技巧接龙......]大家能否将遇到过的数组技巧简单写一下?

northwolves · 发表于 2006-1-9 18:41

Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select

可以写为:

Sheets(Array(1, 2, 3)).Select

彭希仁 · 发表于 2006-1-24 16:12

a = Range("A1:B4").Value 在VBA中试用会出错？
Range("A1:B4").Value＝a 能用

学习分享 · 发表于 2006-1-24 16:45

我是数组盲，跟着学学了！

一只小虾米 · 发表于 2006-1-25 13:18

希望多接一些数组例子。望高手加入！

cooloaky · 发表于 2006-1-25 13:51

对一个数组提取非重复元素进行求和

Function UniqueSum(ByVal ArraySource, ByVal IndexColumn As Integer, ByVal SumColumn As Integer) As Variant
'IndexColumn refers to the column of ArraySource that you want to extract unique items
'SumColumn refers to the column which stored values that you want to do sum

Dim arr()
Dim i, x, k As Long, ds As Object
Set ds = CreateObject("scripting.dictionary") 'create a dictionary to extract unique items
x = 1 'use to record the index of unique item
For i = 1 To UBound(ArraySource, 1)
On Error Resume Next
ds.Add ArraySource(i, IndexColumn), x
If Err.Number = 0 Then 'no duplicate
ReDim Preserve arr(1 To 2, 1 To x) 'make it as horizonal array
arr(1, x) = ArraySource(i, IndexColumn)
arr(2, x) = ArraySource(i, SumColumn)
x = x + 1
Else 'found duplicated item
k = CLng(ds.Item(ArraySource(i, IndexColumn))) 'get the index
If arr(2, k) = "#Err" Or TypeName(ArraySource(i, SumColumn)) = "String" Then
arr(2, k) = "#Err"
Else
arr(2, k) = arr(2, k) + ArraySource(i, SumColumn) 'make summarization
End If
End If
Err.Clear: On Error GoTo 0
Next i
UniqueSum = Application.Transpose(arr) 'transpose horizonal array to vertical
End Function

nawong · 发表于 2006-3-7 12:00

Sheets(Array(1, 2, 3)).Select 高 !

以前只會:

Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select

yfxpzq · 发表于 2006-8-15 06:48

数组我最想从最简单的开始学，有系统点的最好，我渴望

5454440 · 发表于 2006-8-15 09:19

QUOTE:

以下是引用cooloaky在2006-1-25 13:51:42的发言：

对一个数组提取非重复元素进行求和

Function UniqueSum(ByVal ArraySource, ByVal IndexColumn As Integer, ByVal SumColumn As Integer) As Variant
    'IndexColumn refers to the column of ArraySource that you want to extract unique items
    'SumColumn refers to the column which stored values that you want to do sum

    Dim arr()
    Dim i, x, k As Long, ds As Object
    Set ds = CreateObject("scripting.dictionary")       'create a dictionary to extract unique items
    x = 1       'use to record the index of unique item
    For i = 1 To UBound(ArraySource, 1)
        On Error Resume Next
        ds.Add ArraySource(i, IndexColumn), x
        If Err.Number = 0 Then      'no duplicate
            ReDim Preserve arr(1 To 2, 1 To x)      'make it as horizonal array
            arr(1, x) = ArraySource(i, IndexColumn)
            arr(2, x) = ArraySource(i, SumColumn)
            x = x + 1
        Else        'found duplicated item
            k = CLng(ds.Item(ArraySource(i, IndexColumn)))      'get the index
            If arr(2, k) = "#Err" Or TypeName(ArraySource(i, SumColumn)) = "String" Then
                arr(2, k) = "#Err"
            Else
                arr(2, k) = arr(2, k) + ArraySource(i, SumColumn)       'make summarization
            End If
        End If
        Err.Clear: On Error GoTo 0
    Next i
    UniqueSum = Application.Transpose(arr)      'transpose horizonal array to vertical
End Function

能不能请高手中文注释一下这段语句，觉得很有意思可是没有怎么看懂。

5454440 · 发表于 2006-8-15 09:31

1，取工作表区域的绝对引用公式到数组：arr=[a1:c5].Formula

2，取工作表区域的相对引用公式到数组：arr=[a1:c5].Formular1c1

3，取工作表区域的转置到数组：arr=Application.Transpose([a1:c5])
数组间也可以转置：arr1=Application.Transpose(arr)

4，取数组arr的第n列赋值到某列区域：[e1:e5]=Application.Index(arr, , n)
或者赋值产生一个新数组：arr1=Application.Index(arr, , n)

5，同理，取数组arr的第n行赋值到某行区域：[a6:c6]=Application.Index(arr,n , )
或者赋值产生一个新数组：arr1=Application.Index(arr, n, )

这是我以前在网上抄的，和大家分享。也不知道是那个前辈规集的了，不要说盗版哈

5454440 · 发表于 2006-8-15 09:32