提取数据组成新数组

ljc6

我想提取指定值组成新的数组，请教大神刻怎么做啊
谢谢

不知道为什么

看了你的代码

1. 针对你这个需求，不需要使用字典，直接数组就可以

2. 对一维数组和二维数组 貌似你没有完全搞清晰啊
在你原有代码基础上略改，自己找不等同哦

xiangbaoan

Sub jj()
Dim i&, m&, ar, br()
ar = Range("a1").CurrentRegion
For i = 2 To UBound(ar)
    If ar(i, 1) = "王五" Then
        m = m + 1
        ReDim Preserve br(1 To m)
        br(m) = ar(i, 2)
    End If
Next
Range("c2").Resize(m) = Application.WorksheetFunction.Transpose(br)
End Sub

ljc6

xiangbaoan 发表于 2018-9-21 08:09
Sub jj()
Dim i&, m&, ar, br()
ar = Range("a1").CurrentRegion

可以了，非常感谢，我早上自己也摸索了一下
Sub jj()
    Dim i%, ar(), br(), d As Object, mycount
    ar = Range("a1").CurrentRegion
   
        Set d = CreateObject("scripting.dictionary")
    For i = 2 To UBound(ar)
     d(ar(i, 1)) = d(ar(i, 1)) + 1
     Next

     mycount = d("张三")
     ReDim br(1 To mycount, 1 To mycount)
   For i = 2 To UBound(ar)
    If ar(i, 1) = "张三" Then

  m = m + 1
br(1, m) = ar(i, 2)
  
    End If
Range("c2").Resize(mycount, 1) = Application.Transpose(br)
     Next
End Sub
这样也可以
不过还是你的代码好，简单，谢谢

lsc900707

1. Sub jj()
   
2.     Dim br(1 To 999, 1 To 1)
   
3.     ar = [a1].CurrentRegion
   
4.     For i = 2 To UBound(ar)
   
5.         If ar(i, 1) = "王五" Then
   
6.             m = m + 1
   
7.             br(m, 1) = ar(i, 2)
   
8.         End If
   
9.     Next
   
10.     If m Then [c2].Resize(m, 1) = br
    
11. End Sub

复制代码

ljc6

lsc900707 发表于 2018-9-21 12:06

谢谢，这个更简单，我刚接触VBA不久，请问一下，如果数据量很大的话，会不会影响速度，需不需要用字典呢？

lsc900707

ljc6 发表于 2018-9-21 13:34
谢谢，这个更简单，我刚接触VBA不久，请问一下，如果数据量很大的话，会不会影响速度，需不需要用字典呢 ...

不需要字典。这样写比转置更快，你试试就知道！

ljc6

lsc900707 发表于 2018-9-21 14:00
不需要字典。这样写比转置更快，你试试就知道！

好的，谢谢，我试试看，学习下先吃透再说

ljc6

lsc900707 发表于 2018-9-21 14:00
不需要字典。这样写比转置更快，你试试就知道！

如果数据量超过　999行，是不是改成
dim br(1 to 9999,1 to 1)
是不是每次运行，都会运行到999才会结束呢

lsc900707

是这样改，但说法不对。