標題:
[發問]
(已解決)如何尋找關鍵字填入資料
[打印本頁]
作者:
freeffly
時間:
2012-5-10 12:06
標題:
(已解決)如何尋找關鍵字填入資料
本帖最後由 freeffly 於 2012-5-11 16:41 編輯
我想要在"資料"那工作表輸入資料N欄輸入資料
規則如"規則那各工作表
原本我是用篩選的方式去完成
不過我的程式碼很沒效率落落長
下面這各是其中一小部份
如果我要用規則去寫迴圈在自動篩選下可行嗎?
條件一跟條件二基本上是"且"的效果
如果要有且又要有或會不會太難?
目前我想說向下增加項目
讓條件一跟條件二維持在且的部份
不知道各位高手知道我的意思嗎?
On Error GoTo AA項目:
Selection.AutoFilter Field:=14, Criteria1:="="
Selection.AutoFilter Field:=6, Criteria1:="=*團體傷害保險*"
Range("N5:N" & Range("A65536").End(xlUp).Row) = "團體傷害險"
AA項目:
On Error GoTo AAA項目:
Selection.AutoFilter Field:=14, Criteria1:="="
Selection.AutoFilter Field:=6, Criteria1:="=*興清*"
Range("N5:N" & Range("A65536").End(xlUp).Row) = "興清"
AAA項目:
On Error GoTo AB項目:
Selection.AutoFilter Field:=14, Criteria1:="="
Selection.AutoFilter Field:=6
Selection.AutoFilter Field:=2, Criteria1:="=*董監酬勞*"
Range("N5:N" & Range("A65536").End(xlUp).Row) = "估列"
AB項目:
複製代碼
[attach]10890[/attach]
作者:
freeffly
時間:
2012-5-10 16:59
下面是我想的
不過不能執行
請問有人知道該如何修改嗎?
Sub Macro1()
For i = 4 To Sheets("規則").Range("A65536").End(xlUp).Row
n = Sheets("規則").Cells(i, 1)
m = Sheets("規則").Cells(i, 2)
w = Sheets("規則").Cells(i, 3)
x = Sheets("規則").Cells(i, 4)
If Sheets("規則").Cells(i, 3) = "" Then
With Sheets("資料")
.AutoFilter field:=1, criterial:="=" & n & ""
.AutoFilter field:=6, Criteria1:="=*" & m & "*"
.Range("N5:N" & Range("C65536").End(xlUp).Row).SpecialCells(xlCellTypeVisible) = x
End With
Else
With Sheets("資料")
.AutoFilter field:=1, criterial:="=" & n & ""
.AutoFilter field:=6, Criteria1:="=*" & m & "*", Operator:=xlAnd, Criteria2:="=*" & w & "*"
.Range("N5:N" & Range("C65536").End(xlUp).Row).SpecialCells(xlCellTypeVisible) = x
End With
End If
Next
End Sub
複製代碼
作者:
register313
時間:
2012-5-10 17:29
回復
2#
freeffly
規則 改一下順序
[attach]10895[/attach]
Sub xx()
Ar = Sheets("規則").[B4:D9]
With Sheets("資料")
R = .[A4].End(xlDown).Row
Range("N5:N" & R) = ""
Set Rng = .Range("A4:P" & R)
End With
For I = 1 To UBound(Ar)
Rng.AutoFilter Field:=14, Criteria1:="="
Rng.AutoFilter Field:=6, Criteria1:="=*" & Ar(I, 1) & "*", Operator:=xlAnd, Criteria2:="=*" & Ar(I, 2) & "*"
Range("N5:N" & R) = Ar(I, 3)
Rng.AutoFilter
Next I
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
大大
剛執行在我的原始資料才發現
有一個點你沒抓到科目編號
因為不同的科目編號裡面的內容可能有些字眼會相同
資料想要一科目編號 、條件一 條件二的情況下去判斷
因為如果不考慮科目編號有些資料會跑掉
而且我在編規則時是依照科目編號分別去判斷
不知道有沒有方法完成?
我有試著改成下面的方式試
但是結果不對
Sub xx()
Application.ScreenUpdating = False
Ar = Sheets("規則").Range("A2:D" & Sheets("規則").Range("D65536").End(xlUp).Row)
With Sheets("資料")
R = .[A4].End(xlDown).Row
Range("N5:N" & R) = ""
Set Rng = .Range("A4:P" & R)
End With
For I = 1 To UBound(Ar)
Rng.AutoFilter Field:=14, Criteria1:="="
Rng.AutoFilter Field:=1, Criteria1:="=*" & Ar(I, 1) & "*"
Rng.AutoFilter Field:=6, Criteria1:="=*" & Ar(I, 2) & "*", Operator:=xlAnd, Criteria2:="=*" & Ar(I, 3) & "*"
Range("N5:N" & R) = Ar(I, 4)
Rng.AutoFilter
Next I
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這各函數稍微有了解
Sub xx()
Application.ScreenUpdating = False
Ar = Sheets("規則").Range("A2:D" & Sheets("規則").Range("D65536").End(xlUp).Row)
With Sheets("資料")
R = .[A4].End(xlDown).Row
Range("N5:N" & R) = ""
Set Rng = .Range("A4:P" & R)
End With
On Error Resume Next
For I = 1 To UBound(Ar)
Rng.AutoFilter Field:=14, Criteria1:="="
Rng.AutoFilter Field:=1, Criteria1:="=*" & Ar(I, 1) & "*"
Rng.AutoFilter Field:=6, Criteria1:="=*" & Ar(I, 2) & "*", Operator:=xlAnd, Criteria2:="=*" & Ar(I, 3) & "*"
Range("N5:N" & R).SpecialCells(xlCellTypeVisible) = Ar(I, 4)
Rng.AutoFilter
Next I
End Sub
複製代碼
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)