Board logo

標題: [發問] (已解決)如何尋找關鍵字填入資料 [打印本頁]

作者: freeffly    時間: 2012-5-10 12:06     標題: (已解決)如何尋找關鍵字填入資料

本帖最後由 freeffly 於 2012-5-11 16:41 編輯

我想要在"資料"那工作表輸入資料N欄輸入資料
規則如"規則那各工作表
原本我是用篩選的方式去完成
不過我的程式碼很沒效率落落長
下面這各是其中一小部份
如果我要用規則去寫迴圈在自動篩選下可行嗎?
條件一跟條件二基本上是"且"的效果
如果要有且又要有或會不會太難?
目前我想說向下增加項目
讓條件一跟條件二維持在且的部份

不知道各位高手知道我的意思嗎?
  1.     On Error GoTo AA項目:
  2.     Selection.AutoFilter Field:=14, Criteria1:="="
  3.     Selection.AutoFilter Field:=6, Criteria1:="=*團體傷害保險*"
  4.     Range("N5:N" & Range("A65536").End(xlUp).Row) = "團體傷害險"
  5. AA項目:
  6.     On Error GoTo AAA項目:
  7.     Selection.AutoFilter Field:=14, Criteria1:="="
  8.     Selection.AutoFilter Field:=6, Criteria1:="=*興清*"
  9.     Range("N5:N" & Range("A65536").End(xlUp).Row) = "興清"
  10. AAA項目:
  11.     On Error GoTo AB項目:
  12.     Selection.AutoFilter Field:=14, Criteria1:="="
  13.     Selection.AutoFilter Field:=6
  14.     Selection.AutoFilter Field:=2, Criteria1:="=*董監酬勞*"
  15.     Range("N5:N" & Range("A65536").End(xlUp).Row) = "估列"
  16. AB項目:
複製代碼
[attach]10890[/attach]
作者: freeffly    時間: 2012-5-10 16:59

下面是我想的
不過不能執行
請問有人知道該如何修改嗎?
  1. Sub Macro1()
  2.    
  3.     For i = 4 To Sheets("規則").Range("A65536").End(xlUp).Row
  4.     n = Sheets("規則").Cells(i, 1)
  5.     m = Sheets("規則").Cells(i, 2)
  6.     w = Sheets("規則").Cells(i, 3)
  7.     x = Sheets("規則").Cells(i, 4)
  8.     If Sheets("規則").Cells(i, 3) = "" Then
  9.     With Sheets("資料")
  10.         .AutoFilter field:=1, criterial:="=" & n & ""
  11.         .AutoFilter field:=6, Criteria1:="=*" & m & "*"
  12.         .Range("N5:N" & Range("C65536").End(xlUp).Row).SpecialCells(xlCellTypeVisible) = x
  13.     End With
  14.     Else
  15.     With Sheets("資料")
  16.         .AutoFilter field:=1, criterial:="=" & n & ""
  17.         .AutoFilter field:=6, Criteria1:="=*" & m & "*", Operator:=xlAnd, Criteria2:="=*" & w & "*"
  18.         .Range("N5:N" & Range("C65536").End(xlUp).Row).SpecialCells(xlCellTypeVisible) = x
  19.     End With
  20.     End If
  21.    
  22.     Next
  23.    
  24. End Sub
複製代碼

作者: register313    時間: 2012-5-10 17:29

回復 2# freeffly

規則 改一下順序
[attach]10895[/attach]
  1. Sub xx()
  2. Ar = Sheets("規則").[B4:D9]
  3. With Sheets("資料")
  4.   R = .[A4].End(xlDown).Row
  5.   Range("N5:N" & R) = ""
  6.   Set Rng = .Range("A4:P" & R)
  7. End With
  8. For I = 1 To UBound(Ar)
  9.   Rng.AutoFilter Field:=14, Criteria1:="="
  10.   Rng.AutoFilter Field:=6, Criteria1:="=*" & Ar(I, 1) & "*", Operator:=xlAnd, Criteria2:="=*" & Ar(I, 2) & "*"
  11.   Range("N5:N" & R) = Ar(I, 3)
  12.   Rng.AutoFilter
  13. Next I
  14. End Sub
複製代碼

作者: freeffly    時間: 2012-5-10 17:41

回復 3# register313


    請問大大
   改規則的順序的原因?
   我剛剛只發現 "退休金估計差額"這一個的順序要往上
  其他的有影響嗎?
   UBound 真是各妙的函數
  我明天再試試看還有沒有其他問題
作者: register313    時間: 2012-5-10 17:54

回復 4# freeffly

條件1        條件2        對應結果
退休金                退休金
多提        退休金        退休金估計差額

以上2種情形  =>  退休金
也就是條件多的要放前面

你試試看就知道了
作者: freeffly    時間: 2012-5-11 08:36

回復 5# register313


    這各我後來發現了
   當我規則的資料越多就越要注意這各
   我在試試看有沒有其他需要注意的
   
   請問如果我上面用的那種寫法有辦法修改嗎
作者: freeffly    時間: 2012-5-11 15:47

回復 5# register313


    大大
   剛執行在我的原始資料才發現
   有一個點你沒抓到科目編號
   因為不同的科目編號裡面的內容可能有些字眼會相同
   
   資料想要一科目編號 、條件一 條件二的情況下去判斷
   因為如果不考慮科目編號有些資料會跑掉
   而且我在編規則時是依照科目編號分別去判斷
   不知道有沒有方法完成?
    我有試著改成下面的方式試
   但是結果不對
  1. Sub xx()
  2. Application.ScreenUpdating = False
  3. Ar = Sheets("規則").Range("A2:D" & Sheets("規則").Range("D65536").End(xlUp).Row)
  4. With Sheets("資料")
  5.   R = .[A4].End(xlDown).Row
  6.   Range("N5:N" & R) = ""
  7.   Set Rng = .Range("A4:P" & R)
  8. End With
  9. For I = 1 To UBound(Ar)
  10.   Rng.AutoFilter Field:=14, Criteria1:="="
  11.   Rng.AutoFilter Field:=1, Criteria1:="=*" & Ar(I, 1) & "*"
  12.   Rng.AutoFilter Field:=6, Criteria1:="=*" & Ar(I, 2) & "*", Operator:=xlAnd, Criteria2:="=*" & Ar(I, 3) & "*"
  13.   Range("N5:N" & R) = Ar(I, 4)
  14.   Rng.AutoFilter
  15. Next I
  16. End Sub
複製代碼

作者: register313    時間: 2012-5-11 16:31

回復 7# freeffly


Ar = Sheets("規則").Range("A4:D" & Sheets("規則").Range("D65536").End(xlUp).Row)
作者: freeffly    時間: 2012-5-11 16:41

回復 8# register313
   可以了
  不過是改了這一句之後Range("N5:N" & R).SpecialCells(xlCellTypeVisible) = Ar(I, 4)
   因為我的原始資料是從A2開始編規則
  謝謝大大協助
  省下我很多時間
  而且也對UBound這各函數稍微有了解
  1. Sub xx()
  2. Application.ScreenUpdating = False
  3. Ar = Sheets("規則").Range("A2:D" & Sheets("規則").Range("D65536").End(xlUp).Row)
  4. With Sheets("資料")
  5.   R = .[A4].End(xlDown).Row
  6.   Range("N5:N" & R) = ""
  7.   Set Rng = .Range("A4:P" & R)
  8. End With
  9. On Error Resume Next
  10. For I = 1 To UBound(Ar)
  11.   Rng.AutoFilter Field:=14, Criteria1:="="
  12.   Rng.AutoFilter Field:=1, Criteria1:="=*" & Ar(I, 1) & "*"
  13.   Rng.AutoFilter Field:=6, Criteria1:="=*" & Ar(I, 2) & "*", Operator:=xlAnd, Criteria2:="=*" & Ar(I, 3) & "*"
  14.   Range("N5:N" & R).SpecialCells(xlCellTypeVisible) = Ar(I, 4)
  15.   Rng.AutoFilter
  16. Next I
  17. End Sub
複製代碼





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