0

我目前正在尝试在 vba 中创建一个表单以向用户请求一个 pin，并试图让它显示用户相应的首字母缩写，但我的 vlookup 一直没有返回任何值。

我有一个标题为“用户信息”的工作表 A 列是大头针，B 列是首字母

我试图找出一种方法让 VBA 从提示框中获取输入，查看数据并将结果数据粘贴到单元格中。

EG Sheet 1 = Maintenance Press [Record Maintenance] 弹出框提示用户 pin 用户类型 pin 如果 pin 在 userinfo $A:$B 的表中，则复制列 2 将列 2 粘贴到工作表 1 上的单元格 K7（维护）

4

2 回答 2

0

要在 VBA 代码中使用VLOOKUP ，必须将引用样式设置为 R1C1，然后它应该可以工作。

在我看来，使用像 VLOOKUP 这样的 Excel 内置函数会产生更快的代码。另一方面，在 for-each 循环中搜索单元格的值是不好的做法，如果您有大量数据，则将花费大量时间。

这里有一个示例代码。它使用两张表：UserInfo、Maintenance。公式是根据模板字符串设置的，最后调用 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-20T12:25:56.473 回答
0

这是丹尼尔解决方案的替代方案。Daniel 没有任何问题，但我想在不使用该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-20T14:57:50.787 回答