VLookup из книги Excel на сетевом диске - PullRequest
0 голосов
/ 22 октября 2018

Прямо сейчас у меня есть 8 различных элементов управления текстовым полем в пользовательской форме, что при вводе значения запускается макрос, чтобы открыть книгу, сохраненную в сетевой папке, а затем запускается VLookup.Ниже приведен код для двух элементов управления TextBox и, как вы можете видеть (из-за отсутствия у меня возможности кодирования);Я получил 8 отдельных подпрограмм для каждого из текстовых полей, которые открывают рабочую книгу на общем диске после ввода значения в текстовое поле, затем закрывают рабочую книгу и не очень эффективны.После некоторого исследования я думаю, что использование Index и Match было бы лучшим решением, но я не знаком с этими функциями Excel в VBA и мог бы помочь получить начальную точку, используя Index и Match,если это лучшее решение.Спасибо всем за помощь.

  Sub b1CIF()
    Dim CustList As Workbook
    Dim thisWB As Workbook
    Dim thisWS As Worksheet
    Dim wsRR As Worksheet
    Dim bColor As Range
    Dim Msg, Style, Title, Response

    Msg = "OOOPS!" & vbNewLine & vbNewLine & "The CIF Number of " & LendStart.lsPBCIF.Value & " " & "is not correct or does not exist." & vbNewLine & "Please re-enter the CIF Number."
    Style = vbOKCancel + vbCritical
    Title = UCase("***CIF Data Entry Error!***")

    Application.ScreenUpdating = False

    Set CustList = Workbooks.Open("L:\Deposits\Information\Customers.xlsm")
    Set thisWB = ThisWorkbook
    Set thisWS = thisWB.Sheets("SavedInfo")
    Set wsRR = thisWB.Sheets("RiskRating")
    Set bColor = wsRR.Range("C3")

    On Error GoTo ErrHandler

'   NAME GRAB
    If thisWS.Range("A2") <> "" Then
        thisWS.Range("PBName").Value = _
        WorksheetFunction.VLookup(thisWS.Range("A2").Value, CustList.Sheets("CIFMAST").Range("A1:Z50000"), 2, False)
        With LendStart.lsPBName
            .Value = thisWS.Range("PBName")
            .Visible = True
            .Locked = True
            .BackColor = bColor.Interior.Color
            .Font.Bold = True
            .Font.Size = 9
            .TextAlign = fmTextAlignCenter
            .TabStop = False
        End With
        thisWB.Sheets("BorrInfo").Range("PB").Value = thisWS.Range("PBName")
'   TELEPHONE NUMBER GRAB
        thisWB.Sheets("BorrInfo").Range("PBPhone").Value = _
        WorksheetFunction.VLookup(thisWS.Range("A2").Value, CustList.Sheets("CIFMAST").Range("A1:Z50000"), 9, False)
    End If

    CustList.Close
    Application.ScreenUpdating = True

    Exit Sub

ErrHandler:

    LendStart.lsPBSCIF.Value = ""
    With LendStart.lsPBName
        .Value = ""
        .Locked = True
    End With
    Response = MsgBox(Msg, Style, Title)
    CustList.Close
    Application.ScreenUpdating = True

End Sub
Sub b2CIF()
    Dim CustList As Workbook
    Dim thisWB As Workbook
    Dim thisWS As Worksheet
    Dim wsRR As Worksheet
    Dim bColor As Range
    Dim Msg, Style, Title, Response

    Msg = "The CIF Number entered " & LendStart.lsPBSCIF.Value & " " & "is not correct." & vbNewLine & "Please re-enter the CIF Number."
    Style = vbOKCancel + vbCritical
    Title = UCase("***CIF data entry error!***")

    Application.ScreenUpdating = False

    Set CustList = Workbooks.Open("L:\Deposits\Information\Customers.xlsm")
    Set thisWB = ThisWorkbook
    Set thisWS = thisWB.Sheets("SavedInfo")
    Set wsRR = thisWB.Sheets("RiskRating")
    Set bColor = wsRR.Range("C3")

    On Error GoTo ErrHandler

'   NAME GRAB
    If thisWS.Range("A3") <> "" Then
        thisWS.Range("PBSName").Value = _
        WorksheetFunction.VLookup(thisWS.Range("A3").Value, CustList.Sheets("CIFMAST").Range("A1:Z50000"), 2, False)
        With LendStart.lsPBSName
            .Value = thisWS.Range("PBSName")
            .Visible = True
            .Locked = True
            .BackColor = bColor.Interior.Color
            .Font.Bold = True
            .Font.Size = 9
            .TextAlign = fmTextAlignCenter
            .TabStop = False
        End With
        thisWB.Sheets("BorrInfo").Range("PBS").Value = thisWS.Range("PBSName")
'   TELEPHONE NUMBER GRAB
        thisWB.Sheets("BorrInfo").Range("PBSPhone").Value = _
        WorksheetFunction.VLookup(thisWS.Range("A3").Value, CustList.Sheets("CIFMAST").Range("A1:Z50000"), 9, False)
    End If

    CustList.Close
    Application.ScreenUpdating = True

    Exit Sub

ErrHandler:

    LendStart.lsPBSCIF.Value = ""
    Response = MsgBox(Msg, Style, Title)
    CustList.Close
    Application.ScreenUpdating = True

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...