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

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

Dim arr(), rng, s$, Num1%
Sub ex()
Num1 = WorksheetFunction.CountA(Sheets("sheet2").Range("B:B"))
s = 6
rng = [A1].CurrentRegion
For i = 1 To UBound(rng)
If rng(i, 5) = s Then '符合的值
m = m + 1
'為何這行的1 To m會錯誤
ReDim Preserve arr(1 To m, 1 To UBound(rng, 2))
For j = 1 To UBound(rng, 2)
arr(m, j) = rng(i, j)
Next
End If
Next
'這是將sheet2從A1開始貼上,如何改成從sheet2的B欄的Num1+1開始貼上呢?
With Sheets("sheet2").[A1].Resize(UBound(arr) + 1, UBound(arr, 2) + 1)
.Value = arr
.EntireColumn.AutoFit
End With
End Sub

複製代碼

樓主熱帖

PKKO

　暱稱: PKKO

高中生 Rank: 3 Rank: 3

帖子: 549
主題: 152
精華: 0
積分: 691
點名: 0
作業系統: WIN7
軟體版本: OFFICE 2010
閱讀權限: 50
性別: 男
註冊時間: 2013-8-10
最後登錄: 2022-9-7

論壇榮譽勳章論壇贊助勳章

5^#

發表於 2014-11-19 02:21 | 只看該作者

本帖最後由 PKKO 於 2014-11-19 02:22 編輯

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

Sub ex()
Num1 = WorksheetFunction.CountA(Sheets("sheet2").Range("B:B"))
Dim arr(), rng, ar
rng = [A1].CurrentRegion
For i = 1 To UBound(rng) '跑每一列
'If i = 1 Or rng(i, 2) Like 3 Then '跑第一列或是符合的值
If rng(i, 2) Like 3 Then '跑符合的值
m = m + 1
'關鍵1:只有最後一維可以ReDim
ReDim Preserve arr(1 To UBound(rng, 2), 1 To m)
For j = 1 To UBound(rng, 2)
arr(j, m) = rng(i, j)
Next
End If
Next
ar = Application.Transpose(arr)'關鍵2:是可以用轉置的這個方法
'Sheets("Sheet2").Cells.ClearContents
'在B欄的最下方開始貼上
With Sheets("sheet2").Cells(Num1 + 1, 2).Resize(UBound(ar), UBound(ar, 2))
.Value = ar
.EntireColumn.AutoFit
End With
Sheets("Sheet2").Activate
End Sub

複製代碼

PKKO

TOP

PKKO

　暱稱: PKKO

高中生 Rank: 3 Rank: 3

帖子: 549
主題: 152
精華: 0
積分: 691
點名: 0
作業系統: WIN7
軟體版本: OFFICE 2010
閱讀權限: 50
性別: 男
註冊時間: 2013-8-10
最後登錄: 2022-9-7

論壇榮譽勳章論壇贊助勳章

4^#

發表於 2014-11-18 23:57 | 只看該作者

回復 3# luhpro

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

rng = [A1].CurrentRegion
For i = 1 To UBound(rng)
If rng(i, 5) = s Then '符合的值
m = m + 1
ReDim Preserve arr(1 To UBound(rng, 2),1 To m)
For j = 1 To UBound(rng, 2)
arr(j, m) = rng(i, j)
Next
End If
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

TOP

luhpro