麻辣家族討論版版 - Powered by Discuz! Board

標題: filter型態不符合 [打印本頁]

作者: ssooi 時間: 2020-8-1 00:09 標題: filter型態不符合

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

[attach]32354[/attach]

[attach]32355[/attach]

作者: n7822123 時間: 2020-8-1 02:46

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

回復 1# ssooi

因為你的Filter 用法錯啦~~

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

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

[attach]32356[/attach]

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

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

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

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

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

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

再加油吧!

作者: 准提部林 時間: 2020-8-1 09:34

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

有問題再提~~

作者: ssooi 時間: 2020-8-1 13:02

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

Sub 迴圈1()
All = Array("三商", "遠東")
For r = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
For i = 0 To UBound(All)
If Cells(r, 2) = All(i) Then
Rows(r).EntireRow.Copy
Sheets(All).Select
ActiveSheet.Paste
Exit For
End If
Next
Next
End Sub

複製代碼

作者: 軒云熊 時間: 2020-8-1 19:12

本帖最後由軒云熊於 2020-8-1 19:23 編輯

我也是新手順便練習一下不過這段好像哪裡怪怪的但我看不出來請大大們幫幫忙該如何修改感覺好像迴圈太多不必要的代碼好像很多 0.0
Public Sub 練習跨工作表陣列練習()
For x = 2 To Sheets.Count
Sheets(x).Cells.Clear
Sheets(1).Rows(1).Copy Sheets(x).Rows(1)
Next x
E = 2
A = Array("三商", "遠東", "信義")
K = Range(Cells(2, 1), Cells(2, 3).End(xlDown))
ReDim B(LBound(K) To UBound(K))
ReDim Preserve B(LBound(K) To UBound(K))
For x = 2 To Sheets.Count
For J = LBound(K) To UBound(K)
For I = LBound(A) To UBound(A)
If A(I) <> K(J, 2) Then E = 2
If A(I) = K(J, 2) Then
If Sheets(K(J, 2)).Cells(E, 1) <> "" Then E = E + 1
Sheets(K(J, 2)).Cells(E, 1) = K(J, 1)
Sheets(K(J, 2)).Cells(E, 2) = K(J, 2)
Sheets(K(J, 2)).Cells(E, 3) = K(J, 3)
E = E + 1
End If
Next I
Next J
Exit For
Next x
Erase A, K, B
End Sub

複製代碼

作者: 軒云熊 時間: 2020-8-1 19:50

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

作者: 軒云熊 時間: 2020-8-1 20:13

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

這段也不用 ....XD

作者: ssooi 時間: 2020-8-1 20:25

回復 5# 軒云熊

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

作者: 軒云熊 時間: 2020-8-1 20:41

回復 8# ssooi

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

作者: n7822123 時間: 2020-8-1 23:46

本帖最後由 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

檔案如下~

[attach]32357[/attach]

作者: n7822123 時間: 2020-8-2 01:12

本帖最後由 n7822123 於 2020-8-2 01:20 編輯

回復 5# 軒云熊

人家說他成功了，不過沒貼程式無法驗證

但是你的程式還沒成功唷，因為你每次都把E重置為2，

再執行E=E+1，所以E最多=3 (第3列)

遇到同一個地點有3筆資料以上，

你會一直覆蓋各分頁的第3列(第2筆資料)

你可以把資料輸入多一點試試，如下圖

請繼續加油~

[attach]32360[/attach]

作者: 軒云熊 時間: 2020-8-2 11:05

本帖最後由軒云熊於 2020-8-2 11:11 編輯

回復 10# n7822123

謝謝 n7822123 大大的分享小弟研究一下 XD
順便請問為甚麼使用
            D = Array(K(J, 1), K(J, 2), K(J, 3))
            Sheets(K(J, 2)).Rows(E) = D
的時候會出現 #N/A

javascript:;
應該如何寫才不會出現 #N/A

作者: n7822123 時間: 2020-8-2 12:05

本帖最後由 n7822123 於 2020-8-2 12:07 編輯

回復 12# 軒云熊

順便請問為甚麼使用
D = Array(K(J, 1), K(J, 2), K(J, 3))
Sheets(K(J, 2)).Rows(E) = D
的時候會出現 #N/A

Sheets(K(J, 2)).Rows(E) = D

Rows代表整列，而你的D陣列只有3筆資料，所以沒資料的部分就變成"#N/A"

應該如何寫才不會出現 #N/A

等號前面範圍只有3欄而不是整列所有欄，就不會變成#N/A

Sheets(K(J, 2)).Cells(E, 1).Resize(, 3) = D

依陣列資料筆數的彈性寫法 (你的陣列從0開始，所以要加1)

Sheets(K(J, 2)).Cells(E, 1).Resize(, UBound(D) + 1) = D

作者: 軒云熊 時間: 2020-8-2 15:18

本帖最後由軒云熊於 2020-8-2 15:21 編輯

回復 13# n7822123
謝謝 n7822123 的說明我明白了請問那如果要讓 A = Array("三商", "遠東", "信義") 變成動態有彈性該如何寫呢?
因為現在有一個問題就是如果工作表變多了也只會比對3個工作表想法是把工作表名子丟到Array()裡面但是不知道怎麼丟欄跟列的問題我是這樣寫

Public Sub 跨工作表陣列練習()
For X = 2 To Sheets.Count
Sheets(X).Cells.Clear
Next X
A = Array("三商", "遠東", "信義")
K = Range(Cells(2, 1), Cells(2, 4).End(xlDown))
F = Cells(1, Columns.Count).End(xlToLeft).Column
For J = LBound(K) To UBound(K)
For i = LBound(A) To UBound(A)
If A(i) = K(J, 2) Then
If Sheets(K(J, 2)).Cells(1, 1) = "" Then Sheets(1).Rows(1).Copy Sheets(K(J, 2)).Rows(1)
For D = 1 To F
Sheets(K(J, 2)).Cells(Rows.Count, D).End(xlUp).Offset(1, 0) = K(J, D)
Next D
End If
Next i
Next J
Erase A, K
Sheets(1).Select
Cells(1, 1).Select
End Sub

複製代碼

作者: n7822123 時間: 2020-8-2 16:30

本帖最後由 n7822123 於 2020-8-2 16:38 編輯

回復 14# 軒云熊

欄跟列的問題我是這樣寫

如果你不考慮"執行效率"的話，你的程式在功能上是沒有問題的

論到"執行效率"準大才是行家，我也只是一般水準

準大寫的程式在"執行效率"上，都有非常高的水準!

不過準大有時會為了執行效率，把程式寫的比較繞，沒那麼直覺，

新手真的不易看懂，所以不建議新手去看準大的程式

這與我的寫作習慣不太一樣，我認為寫直覺、直接一點比較好用於維護(若以後程式需要更新、修改)

所以我認為我的程式應該是比較"親民"一點~ 當然不代表新手就能看得懂

請問那如果要讓  A = Array("三商", "遠東", "信義")  變成動態有彈性該如何寫呢?

要先下邏輯，除了本身工作表以外的工作表都納入A陣列，可以這樣寫

Dim A(): K = -1
For Each sh In Sheets
  If sh.Name <> ActiveSheet.Name Then
K = K + 1: ReDim Preserve A(K)
A(K) = sh.Name
  End If
Next

作者: n7822123 時間: 2020-8-2 16:48

本帖最後由 n7822123 於 2020-8-2 16:49 編輯

回復 15# n7822123

上面是"動態陣列" 的寫法，但這不是我的風格

我的習慣是用 "動態字串"，再轉陣列，自由度我覺得更高(A既可以是字串，也可以是陣列)

如下，看你喜歡哪一個

Dim A
For Each sh In Sheets
If sh.Name <> ActiveSheet.Name Then A = A & "," & sh.Name
Next
A = Split(Mid(A, 2), ",")

作者: 軒云熊 時間: 2020-8-2 18:30

謝謝 n7822123 的分享與教學小弟學到新的東西了真的非常感謝
下面是結果缺點真的變慢了....XD 因為我的迴圈太多了..
我會慢慢研究 n7822123大大還有準提大大所寫的方式
但有很多看不懂是真的. 不過我慢慢研究如果不懂的地方還要麻煩前輩們指教 ^^"

Public Sub 跨工作表陣列練習()
Dim A()
For X = 2 To Sheets.Count
Sheets(X).Cells.Clear
ReDim Preserve A(X - 2)
A(X - 2) = Sheets(X).Name
Next X
F = Cells(1, Columns.Count).End(xlToLeft).Column
K = Range(Cells(2, 1), Cells(2, F).End(xlDown))
For J = LBound(K) To UBound(K)
For i = LBound(A) To UBound(A)
If A(i) = K(J, 2) Then
If Sheets(K(J, 2)).Cells(1, 1) = "" Then Sheets(1).Rows(1).Copy Sheets(K(J, 2)).Rows(1)
For D = 1 To F
Sheets(K(J, 2)).Cells(Rows.Count, D).End(xlUp).Offset(1, 0) = K(J, D)
Next D
End If
Next i
Next J
Erase A, K
Sheets(1).Select
Cells(1, 1).Select
End Sub

複製代碼

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