標題: [發問] 請問有無可以取代VLOOKUP函數的VBA寫法... [打印本頁]

---

作者: GGGYYY    時間: 2015-3-27 23:16     標題: 請問有無可以取代VLOOKUP函數的VBA寫法...

由於VLOOKUP只能單純輸入查詢參照"值"
但如果需要連同格式一起複製過來應該沒有函數可以使用
所以想請問大家有無VBA寫法或是其他方法可以取代...
( VLOOKUP+設定格式化條件這方式無法使用在超過3個條件的公式裡。PS.EXCEL是使用2003的 )
附件有舉例...
大家一起來研究看看吧...

---

作者: koo    時間: 2015-3-27 23:59

未下載附件初學者亂回單純參考..剛測了一下有把格式複製過去(紅字粗體)
可以用Cells.Find跑VLOOKUP
cy = Sheets(2).Cells(i, "D")
Sheets(1).Select
Set kx = Cells.Find(What:=cy, After:=ActiveCell)
另外多條件也可以用and
if cells(1,1)="項目" and cells(1,2)="價格" then
格式部分也可以在程序加上
改紅色字體
Cells(2, 2).Font.ColorIndex = 3
填滿黃色
Cells(2, 2).Interior.ColorIndex = 6

---

作者: GBKEE    時間: 2015-3-28 10:14

回復 1# GGGYYY
試試看

1. Option Explicit
   
2. Sub Ex_Match() '大小寫沒有分別
   
3.     Dim M As Variant, Rng As Range, E As Range
   
4.     Set Rng = Sheets("對照").Range("A:A")
   
5.     For Each E In Sheets("數值").UsedRange.Columns(1).Offset(1).Cells
   
6.         M = Application.Match(E, Rng, 0)   '沒找到傳回錯誤值
   
7.         If IsNumeric(M) Then               '找到傳回數字
   
8.             Rng.Cells(M, 2).Resize(, 2).Copy E.Offset(, 1)
   
9.         Else
   
10.             With E.Cells(1, 2).Resize(, 2)
    
11.                 .Value = ""
    
12.                 .Interior.ColorIndex = xlNo
    
13.             End With
    
14.         End If
    
15.     Next
    
16. End Sub
    
17. 
    
18. Sub Ex_字典物件() '大小寫有分別
    
19.     Dim E As Range, d As Object, i As Integer
    
20.     Set d = CreateObject("scripting.dictionary") '字典物件
    
21.     i = 1
    
22.     With Sheets("對照")
    
23.         Do While .Cells(i, "a") <> ""
    
24.             Set d(.Cells(i, "a").Value) = .Cells(i, "a").Offset(, 1).Resize(, 2)
    
25.             i = i + 1
    
26.         Loop
    
27.     End With
    
28.     For Each E In Sheets("數值").UsedRange.Columns(1).Offset(1).Cells
    
29.         If d.EXISTS(E.Value) Then   'Dictionary 物件中指定的關鍵字存在，傳回 True，若不存在，傳回 False。
    
30.             d(E.Value).Copy E.Offset(, 1)
    
31.         Else
    
32.             With E.Cells(1, 2).Resize(, 2)
    
33.                 .Value = ""
    
34.                 .Interior.ColorIndex = xlNo
    
35.             End With
    
36.         End If
    
37.     Next
    
38. End Sub

複製代碼

---

作者: GGGYYY    時間: 2015-3-28 21:42

測試結果
前16行就可以解決該問題...
18-38行是另一種解法對吧...
兩種都可以解出答案...
感謝版主的提點...

---

作者: pegawang    時間: 2015-3-30 15:37

小弟不才，分享自行寫出的公式吧
Sub Find()
x = InputBox("請輸入數值")
Dim range1 As Range
Set range1 = Range("d2:i1000").Find(what:=x, LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlRows, matchbyte:=True)
MsgBox (range1.Address)
End Sub
再利用FindNext可以繼續下一個

---

作者: GBKEE    時間: 2015-3-30 16:01

回復 5# pegawang
當 range1 Is Nothing   
MsgBox (range1.Address)  會出錯的

---

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