filter型態不符合

ssooi

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

book1.zip (8.43 KB)

book
下載次數: 9

2020-8-1 00:08

code.zip (378 Bytes)

code
下載次數: 8

2020-8-1 00:08

n7822123

回復 1# ssooi


因為你的Filter 用法錯啦~~

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

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

下載 (14.88 KB)

2020-8-1 02:43

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

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

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

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

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

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

再加油吧!

准提部林

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

有問題再提~~

ssooi

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

1. Sub 迴圈1()
   
2. 
   
3. All = Array("三商", "遠東")
   
4. 
   
5. For r = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
   
6.    
   
7.     For i = 0 To UBound(All)
   
8.    
   
9.         If Cells(r, 2) = All(i) Then
   
10.             Rows(r).EntireRow.Copy
    
11.             Sheets(All).Select
    
12.             ActiveSheet.Paste
    
13.             Exit For
    
14.         End If
    
15.         
    
16.     Next
    
17. Next
    
18. 
    
19. End Sub

複製代碼

軒云熊

1. 我也是新手順便練習一下 不過這段好像哪裡怪怪的  但我看不出來 請大大們 幫幫忙 該如何修改 感覺 好像迴圈 太多 不必要的代碼 好像很多 0.0
   
2. Public Sub 練習跨工作表陣列練習()
   
3. 
   
4.     For x = 2 To Sheets.Count
   
5.         Sheets(x).Cells.Clear
   
6.         Sheets(1).Rows(1).Copy Sheets(x).Rows(1)
   
7.     Next x
   
8.    
   
9.     E = 2
   
10.     A = Array("三商", "遠東", "信義")
    
11.     K = Range(Cells(2, 1), Cells(2, 3).End(xlDown))
    
12.     ReDim B(LBound(K) To UBound(K))
    
13.     ReDim Preserve B(LBound(K) To UBound(K))
    
14. 
    
15.     For x = 2 To Sheets.Count
    
16.         For J = LBound(K) To UBound(K)
    
17.             For I = LBound(A) To UBound(A)
    
18.             If A(I) <> K(J, 2) Then E = 2
    
19.                 If A(I) = K(J, 2) Then
    
20.                 If Sheets(K(J, 2)).Cells(E, 1) <> "" Then E = E + 1
    
21.                     Sheets(K(J, 2)).Cells(E, 1) = K(J, 1)
    
22.                     Sheets(K(J, 2)).Cells(E, 2) = K(J, 2)
    
23.                     Sheets(K(J, 2)).Cells(E, 3) = K(J, 3)
    
24.                     E = E + 1
    
25.                 End If
    
26.             Next I
    
27.         Next J
    
28.     Exit For
    
29.     Next x
    
30.    
    
31.     Erase A, K, B
    
32.    
    
33. End Sub

複製代碼

軒云熊

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

軒云熊

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

這段也不用 ....XD

ssooi

回復 5# 軒云熊


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

軒云熊

回復 8# ssooi


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

n7822123

回復 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)

下載次數: 5

2020-8-1 23:46