返回列表 上一主題 發帖

filter型態不符合

filter型態不符合

我先將各個地點做成一個陣列
然後將Sheet1裡面的地點與陣列做比對
若符合該地點,則將該地點整列的資料複製到該地點的分頁
但我做到一半就卡住了
錯誤訊息是型態不符合

book1.zip (8.43 KB)

code.zip (378 Bytes)

本帖最後由 n7822123 於 2020-8-1 02:48 編輯

回復 1# ssooi


因為你的Filter 用法錯啦~~

第1個參數要放入 "陣列",第2個參數要放入 "字串"

初學者請善用 "F1" 來查用法



Filter用法.png
2020-8-1 02:43



所以依你的程式  Filter(a,all(i)) 要改成 Filter(all,a)

剛好有個範例可以用Filter示範給你看,如下鏈結


http://forum.twbts.com/thread-8370-1-1.html

不過你的程式不只這個問題......

有不少語法錯誤,還有邏輯問題......

你的IF可能永遠進不去......進去了也會執行失敗

再加油吧!
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

基本操作功能--篩選, 應可處理這個問題,
先使用錄製取得程式碼...研究下...

有問題再提~~

TOP

各位高手,真的盡力了~filter一直搞不定,用另外一種寫法,寫到這裡,不知道問題在哪,無法將整列複製到指定工作表的最後一欄,謝謝各位高手
  1. Sub 迴圈1()

  2. All = Array("三商", "遠東")

  3. For r = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
  4.    
  5.     For i = 0 To UBound(All)
  6.    
  7.         If Cells(r, 2) = All(i) Then
  8.             Rows(r).EntireRow.Copy
  9.             Sheets(All).Select
  10.             ActiveSheet.Paste
  11.             Exit For
  12.         End If
  13.         
  14.     Next
  15. Next

  16. End Sub
複製代碼

TOP

本帖最後由 軒云熊 於 2020-8-1 19:23 編輯
  1. 我也是新手順便練習一下 不過這段好像哪裡怪怪的  但我看不出來 請大大們 幫幫忙 該如何修改 感覺 好像迴圈 太多 不必要的代碼 好像很多 0.0
  2. Public Sub 練習跨工作表陣列練習()

  3.     For x = 2 To Sheets.Count
  4.         Sheets(x).Cells.Clear
  5.         Sheets(1).Rows(1).Copy Sheets(x).Rows(1)
  6.     Next x
  7.    
  8.     E = 2
  9.     A = Array("三商", "遠東", "信義")
  10.     K = Range(Cells(2, 1), Cells(2, 3).End(xlDown))
  11.     ReDim B(LBound(K) To UBound(K))
  12.     ReDim Preserve B(LBound(K) To UBound(K))

  13.     For x = 2 To Sheets.Count
  14.         For J = LBound(K) To UBound(K)
  15.             For I = LBound(A) To UBound(A)
  16.             If A(I) <> K(J, 2) Then E = 2
  17.                 If A(I) = K(J, 2) Then
  18.                 If Sheets(K(J, 2)).Cells(E, 1) <> "" Then E = E + 1
  19.                     Sheets(K(J, 2)).Cells(E, 1) = K(J, 1)
  20.                     Sheets(K(J, 2)).Cells(E, 2) = K(J, 2)
  21.                     Sheets(K(J, 2)).Cells(E, 3) = K(J, 3)
  22.                     E = E + 1
  23.                 End If
  24.             Next I
  25.         Next J
  26.     Exit For
  27.     Next x
  28.    
  29.     Erase A, K, B
  30.    
  31. End Sub
複製代碼

TOP

剛才試著把  For x = 2 To Sheets.Count 迴圈刪除 結果發現 根本用不到 ........XD

TOP

ReDim B(LBound(K) To UBound(K))
ReDim Preserve B(LBound(K) To UBound(K))
Erase B

這段也不用 ....XD

TOP

回復 5# 軒云熊


謝謝諸位高手
我成功了
謝謝!

TOP

回復 8# ssooi


    E = E + 1 這段也不用 .....XD  抱歉 我也是新手我們可以互相學習

TOP

本帖最後由 n7822123 於 2020-8-1 23:56 編輯

回復 8# ssooi

恭喜恭喜,大概能猜出你們是用2個迴圈做比對的寫法~

手癢了一下,我也公佈我的寫法吧,只有"一個迴圈"

如果用準大提到的 工作表"篩選"功能,應該會寫的更簡單

每個分頁,我自己多複製了"標題列",這樣感覺比較正常~

這個題目用G大喜歡用的Match函數就可以輕鬆解決了

如果你們想要讓程式更加快狠準Match函數值得你花時間研究一下用法

程式如下


Sub Test0801()
All = Array("三商", "遠東", "信義")
Rn = [A1].End(4).Row
For R = 1 To Rn
  B = Application.Match(Cells(R, 2), All, 0)
  If Not IsError(B) Then '地點是否在All陣列內
    With Sheets(Cells(R, 2).Value)
      Ro = .Cells(Rows.Count, 1).End(3).Row '找每頁最末列
      If Ro = 1 And .[A1] = "" Then Range([A1], [A1].End(2)).Copy .[A1]     '複製標提列
      Ro = Ro + 1: Range(Cells(R, 1), Cells(R, 1).End(2)).Copy .Cells(Ro, 1) '複製資料
    End With
  End If
Next
End Sub


檔案如下~

Test0801.rar (17.84 KB)
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

        靜思自在 : 人事的艱難與琢磨,就是一種考驗。
返回列表 上一主題