Board logo

標題: [發問] 如何在sheet1查詢資料後輸出到sheet2的特定位置(透過陣列) [打印本頁]
作者: PKKO    時間: 2014-11-18 00:34     標題: 如何在sheet1查詢資料後輸出到sheet2的特定位置(透過陣列)

想請教一下,陣列的用法,問題如附註的說明
  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    時間: 2014-11-18 06:30

小弟剛剛爬文,目前只學會了(非陣列方式)的方法
但還是想問一下大大們.這種方式要如何只貼上值?如何貼到指定儲存格例如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    時間: 2014-11-18 23:43

想請教一下,陣列的用法,問題如附註的說明...
'為何這行的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    時間: 2014-11-18 23:57

回復 3# luhpro


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

  3.         For i = 1 To UBound(rng)

  5.             If rng(i, 5) = s Then '符合的值

  7.                 m = m + 1

  9.                 ReDim Preserve arr(1 To UBound(rng, 2),1 To m)

  11.                 For j = 1 To UBound(rng, 2)

  13.                   arr(j, m) = rng(i, j)

  15.                 Next

  17.             End If

  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    時間: 2014-11-19 02:21

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

回復 3# luhpro
大大我成功了,可以透過陣列的方式直接篩選,並且將值輸出到任意sheet內的任意位置
  1. Sub ex()
  2. Num1 = WorksheetFunction.CountA(Sheets("sheet2").Range("B:B"))

  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
複製代碼




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)