帶提示的Vlookup

我目前正在試圖用vba做一個表單來向用戶請求一個pin，並試圖讓它顯示用戶對應的首字母縮寫，但是我的vlookup並沒有返回任何值。帶提示的Vlookup

我有標題爲「用戶信息」 A列是銷工作表，列B是英文縮寫

我試圖找出一種方式，VBA，從提示框取輸入，VLOOKUP的數據，將結果數據粘貼到單元格中。

EG 表1 =維護按[記錄維護] 框彈出提示使用者銷用戶類型銷如果銷是在表中用戶信息$ A：$ B，然後複製柱2 粘貼柱2插入紙1（維護）細胞K7

2013-07-19 user2600850

那麼到目前爲止你有什麼代碼？ –

只是一點小技巧，不要過分關注vlookup。一旦你學習VBA，你將不需要它。重點學習如何將用戶窗體中的值設置爲變量，然後將列A設置爲範圍，遍歷範圍內的所有單元格（使用'for each'循環），如果值匹配，則獲取B列中的單元格，然後將列K中單元格的值設置爲等於此值。弄清楚如何逐一完成這些步驟，並且你將會很好。 – UberNubIsTrue

要使用VLOOKUP VBA碼內有必要參考樣式設置爲R1C1，那麼它應該工作。

在我看來，使用excel內置的函數，如VLOOKUP將會產生更快的代碼。另一方面，爲每個循環搜索單元格中的值是不好的做法，如果您有大量數據，則需要很長時間。

這裏的示例代碼。它使用兩張表格：用戶信息，維護。該公式基於模板字符串設置，最後調用Evaluate（）以獲取結果。 HTH。

Public Sub test() 
     Dim pin 
     pin = VBA.InputBox("Enter PIN", "PIN") 
     If (pin = "") Then Exit Sub 

     Dim userInfoSheet As Worksheet 
     Set userInfoSheet = Worksheets("UserInfo") 

     Dim dataRange As Range 
     Set dataRange = userInfoSheet.Columns("a:b") 

     Dim initailsColumn As Byte 
     initailsColumn = dataRange.Columns(2).Column 

     Dim originalReferenceStyle 
     originalReferenceStyle = Application.ReferenceStyle 
     Application.ReferenceStyle = xlR1C1 

     Dim lookup As String 
     Const EXACT_MATCH As Integer = 0 
     lookup = "=VLOOKUP({PIN}, {DATA_RANGE}, {INITIALS_COLUMN}, {MATCH_TYPE})" 
     lookup = VBA.Replace(lookup, "{PIN}", pin) 
     lookup = VBA.Replace(lookup, "{DATA_RANGE}", dataRange.Worksheet.Name & "!" & dataRange.Address(ReferenceStyle:=xlR1C1)) 
     lookup = VBA.Replace(lookup, "{INITIALS_COLUMN}", initailsColumn) 
     lookup = VBA.Replace(lookup, "{MATCH_TYPE}", EXACT_MATCH) 

     Dim result As Variant 
     result = Application.Evaluate(lookup) 

     Application.ReferenceStyle = originalReferenceStyle 

     If (Not VBA.IsError(result)) Then 
      Dim maintenanceSheet As Worksheet 
      Set maintenanceSheet = Worksheets("Maintenance") 
      maintenanceSheet.Range("k7").Value = result 
     Else 
      Dim parsedError As String 
      parsedError = ParseEvaluateError(result) 
      MsgBox "Error: " & parsedError, vbExclamation, "Error" 
     End If 

    End Sub 

    Private Function ParseEvaluateError(ByRef errorValue As Variant) As String 
     Dim errorNumber As Long 
     Dim errorMessage As String 

     errorNumber = VBA.CLng(errorValue) 
     Select Case errorNumber 
      Case 2000: 
       errorMessage = "#NULL!" 
      Case 2007: 
       errorMessage = "#DIV/0!" 
      Case 2015: 
       errorMessage = "#VALUE!" 
      Case 2023: 
       errorMessage = "#REF!" 
      Case 2029: 
       errorMessage = "#NAME?" 
      Case 2036: 
       errorMessage = "#NUM!" 
      Case 2042: 
       errorMessage = "#N/A" 
      Case Else 
       errorMessage = "Unknow" 
     End Select 
     ParseEvaluateError = errorMessage 
    End Function

來源

2013-07-20 12:25:56 dee

這是你在那裏的一些可靠的代碼。我同意你的評論，認爲使用'for each'循環來搜索單元格通常是不好的做法（我個人會利用'Search'對象，這在大型數據集上會快得多）。我沒有在上面的評論中提出建議，因爲OP剛開始學習VBA的基礎知識，並且設置'Search'對象可能有些過於先進。我的想法是，通過學習設置範圍對象和理解循環如何工作等基礎知識，OP將從中受益匪淺。 – UberNubIsTrue

@UberNubIsTrue：是的，每次都可以開始。我剛剛試圖回答有關查詢的問題。 – dee

以下是丹尼爾解決方案的替代方案。 Daniel's沒有錯，但我想在不使用Vlookup函數的情況下展示解決方案。通過消除Vlookup函數，您不必處理該函數可能返回的不同錯誤消息。這完全是個人偏好。

Option Explicit 

Sub TEST() 
Dim PIN As Variant 
Dim WRKSHT_USERINFO As Excel.Worksheet 
Dim WRKSHT_MAINTENANCE As Excel.Worksheet 
Dim COLUMN_WITH_INITIALS As Long 
Dim CELL_WITH_INITIALS_MATCHING_PIN As Range 
Dim DESTINATION_CELL As Range 

PIN = VBA.InputBox("Enter PIN", "PIN") 
If PIN = vbNullString Then Exit Sub 

Set WRKSHT_USERINFO = ThisWorkbook.Sheets("userinfo") 
Set WRKSHT_MAINTENANCE = ThisWorkbook.Sheets("Maintenance") 
Set DESTINATION_CELL = WRKSHT_MAINTENANCE.Range("K7") 

COLUMN_WITH_INITIALS = 2 ''Column B 

Set CELL_WITH_INITIALS_MATCHING_PIN = Get_Cell_With_Initials(WRKSHT_USERINFO, PIN, COLUMN_WITH_INITIALS) 

If CELL_WITH_INITIALS_MATCHING_PIN Is Nothing Then 
    MsgBox "No Records Found For PIN: " & PIN 
    Exit Sub 
Else 
    WRKSHT_MAINTENANCE.Range(DESTINATION_CELL.Address).Value = CELL_WITH_INITIALS_MATCHING_PIN.Value 
End If 

End Sub 

Function Get_Cell_With_Initials(ByRef WRKSHT_USERINFO As Excel.Worksheet, ByVal PIN As Variant, ByVal COLUMN_WITH_INITIALS As Long) As Range 
Dim SEARCH_OBJECT As Object 
Dim ROW_WITH_VALUE As Long 

Set SEARCH_OBJECT = Cells.Find(What:=PIN, After:=WRKSHT_USERINFO.Cells(1, 1), LookIn:=xlValues, LookAt _ 
    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ 
    False, SearchFormat:=False) 

If SEARCH_OBJECT Is Nothing Then 
    Exit Function 
Else 
    ROW_WITH_VALUE = SEARCH_OBJECT.Row 
End If 

Set Get_Cell_With_Initials = WRKSHT_USERINFO.Cells(ROW_WITH_VALUE, COLUMN_WITH_INITIALS) 

End Function

來源

2013-07-20 14:57:50 UberNubIsTrue

帶提示的Vlookup

回答

相關問題