[發問] 如何在sheet1查詢資料後輸出到sheet2的特定位置(透過陣列)

PKKO

想請教一下,陣列的用法,問題如附註的說明

1. Dim arr(), rng, s$, Num1%
   
2. Sub ex()
   
3.     Num1 = WorksheetFunction.CountA(Sheets("sheet2").Range("B:B"))
   
4.         s = 6
   
5.         rng = [A1].CurrentRegion
   
6.         For i = 1 To UBound(rng)
   
7.             If rng(i, 5) = s Then '符合的值
   
8.                 m = m + 1
   
9.                 '為何這行的1 To m會錯誤
   
10.                 ReDim Preserve arr(1 To m, 1 To UBound(rng, 2))
    
11.                 For j = 1 To UBound(rng, 2)
    
12.                   arr(m, j) = rng(i, j)
    
13.                 Next
    
14.             End If
    
15.         Next
    
16.       
    
17.         
    
18.     '這是將sheet2從A1開始貼上,如何改成從sheet2的B欄的Num1+1開始貼上呢?
    
19.     With Sheets("sheet2").[A1].Resize(UBound(arr) + 1, UBound(arr, 2) + 1)
    
20.         .Value = arr
    
21.         .EntireColumn.AutoFit
    
22.     End With
    
23.    
    
24. End Sub

複製代碼

PKKO

小弟剛剛爬文,目前只學會了(非陣列方式)的方法
但還是想問一下大大們.這種方式要如何只貼上值?如何貼到指定儲存格例如b3,而非從A1開始貼

1. '重新篩選指定日期
   
2.      With Sheets("會員資料")
   
3.         .AutoFilterMode = False
   
4.         With [A1].CurrentRegion
   
5.             .AutoFilter 31, DD  '篩選指定日
   
6.             .AutoFilter 12, "第" & manyCar & "車"  '篩選公司車
   
7.             .Copy '複製
   
8.         End With
   
9.         
   
10.         With Sheets("指定洗")
    
11.               .Paste '貼上
    
12.         End With
    
13.         .AutoFilterMode = False
    
14.     End With
    
15.     Application.CutCopyMode = xlCopy '清除剪貼簿

複製代碼

luhpro

想請教一下,陣列的用法,問題如附註的說明...
'為何這行的1 To m會錯誤
ReDim Preserve arr(1 To m, 1 To UBound(rng, 2))
...
PKKO 發表於 2014-11-18 00:34

ReDim 只能增減最後一個柱標

'這是將sheet2從A1開始貼上,如何改成從sheet2的B欄的Num1+1開始貼上呢?
With Sheets("sheet2").[A1].Resize(UBound(arr) + 1, UBound(arr, 2) + 1)

With Sheets("sheet2").Cells(Num + 1, 2).Resize(UBound(arr) + 1, UBound(arr, 2) + 1)

小弟剛剛爬文,目前只學會了(非陣列方式)的方法
但還是想問一下大大們.這種方式要如何只貼上值?如何貼到指定 ...
PKKO 發表於 2014-11-18 06:30

儲存格表示方式:
[欄名列名] 如 [A1]
Cells(列號,欄號) : Cells(7,2)=[B7]

PKKO

回復 3# luhpro


    luhpro 大您的意思是說:ReDim 只能增減最後一個柱標,所以二維陣列只能增減第二維的部分,一維陣列則沒有這個問題囉?
那我原本的程式碼,陣列的值與cells剛好是反過來的,要如何轉回來?

1. rng = [A1].CurrentRegion
   
2. 
   
3.         For i = 1 To UBound(rng)
   
4. 
   
5.             If rng(i, 5) = s Then '符合的值
   
6. 
   
7.                 m = m + 1
   
8. 
   
9.                 ReDim Preserve arr(1 To UBound(rng, 2),1 To m)
   
10. 
    
11.                 For j = 1 To UBound(rng, 2)
    
12. 
    
13.                   arr(j, m) = rng(i, j)
    
14. 
    
15.                 Next
    
16. 
    
17.             End If
    
18. 
    
19.         Next

複製代碼

With Sheets("sheet2").Cells(Num + 1, 2).Resize(UBound(arr) + 1, UBound(arr, 2) + 1)
我學起來了,感恩,因為小弟不太懂Resize的用法

With Sheets("指定洗")

              .Paste '貼上

        End With

可以直接用.cells(x,y)的方式接著貼上的話,那太方便了,我待會試試看

PKKO

回復 3# luhpro
大大我成功了,可以透過陣列的方式直接篩選,並且將值輸出到任意sheet內的任意位置

1. Sub ex()
   
2. Num1 = WorksheetFunction.CountA(Sheets("sheet2").Range("B:B"))
   
3. 
   
4.      Dim arr(), rng, ar
   
5.     rng = [A1].CurrentRegion
   
6.         For i = 1 To UBound(rng) '跑每一列
   
7.           'If i = 1 Or rng(i, 2) Like 3 Then '跑第一列或是符合的值
   
8.             If rng(i, 2) Like 3 Then '跑符合的值
   
9.             m = m + 1
   
10.             '關鍵1:只有最後一維可以ReDim
    
11.             ReDim Preserve arr(1 To UBound(rng, 2), 1 To m)
    
12.             For j = 1 To UBound(rng, 2)
    
13.               arr(j, m) = rng(i, j)
    
14.             Next
    
15.           End If
    
16.         Next  
    
17.   ar = Application.Transpose(arr)'關鍵2:是可以用轉置的這個方法
    
18.      'Sheets("Sheet2").Cells.ClearContents
    
19.     '在B欄的最下方開始貼上
    
20.     With Sheets("sheet2").Cells(Num1 + 1, 2).Resize(UBound(ar), UBound(ar, 2))
    
21.         .Value = ar
    
22.         .EntireColumn.AutoFit
    
23.     End With
    
24.    
    
25.     Sheets("Sheet2").Activate
    
26. End Sub

複製代碼