如果匹配工作簿

时间:2015-06-11 09:47:25

标签: excel vba excel-vba excel-2010

我有两个文件可以使用。一个是要更新的文件,另一个是包含新数据。

这两个文件都包含材料编号和有关此材料的信息(数量等),因此我希望将所有新值(属于同一行的一部分)复制到另一个文件中该行的正确位置。

我设法让一切正常工作,除了VLOOKUP(应该需要......)。

任何? :)

'################################################################################################
'################################################################################################
'######### fnopen():    Opens a FileDialog, allowing the user to choose the GLA File.   #########
'#########              Returns directory/filename of selected as String                #########
'################################################################################################
'################################################################################################

Function fnopen() As String

    Dim strFileToOpen As String

    strFileToOpen = Application.GetOpenFilename _
        (Title:="Please choose GLA501 to open")
        '# Change name of FileDialog (is being displayed)
    Workbooks.Open filename:=strFileToOpen
    '# Open Workbook
    fnopen = strFileToOpen
    MsgBox fnopen & "     1"
    MsgBox strFileToOpen & "     2"

End Function

'################################################################################################
'################################################################################################

'################################################################################################
'######### MakeRow(): Creates String of Cell out of row and String                      #########
'################################################################################################

Function MakeRow(rowno As Integer, col As String) As String

    MakeRow = col & CStr(rowno)

End Function

'################################################################################################
'######### getmat():    Requires row no. and returns material no.                       #########
'################################################################################################

Function getmat(rowno As Integer, col As String) As String

    getmat = Range(MakeRow(rowno, col)).Value

End Function

'################################################################################################
'################################################################################################

Function fcat(gla_path As String, gla_name As String, lastrow As Integer) As Integer

    Dim srchRange As Range, found_in_location As Range, lookFor As Range
    Dim rowno As Integer, counter As Integer
    Dim col As String

    rowno = 16
    col = "F"

    counter = 0

    Dim book1 As Workbook
    Dim book2 As Workbook

    Set book1 = ThisWorkbook
    Set book2 = Workbooks(gla_name)

    Set lookFor = book2.Sheets(1).Cells(rowno, 6)   ' value to find
    Set srchRange = book1.Sheets(2).Range(MakeRow(rowno, col), MakeRow(lastrow, col))    'source

    Set found_in_location = srchRange.Columns(1).Find(What:=lookFor, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
    If Not found_in_location Is Nothing Then
      found_in_location.Offset(0, 85).Value = lookFor.Offset(0, 79)
    Else
      counter = counter + 1
    End If

    fcat = counter

End Function

'################################################################################################
'################################################################################################

Sub annualazy()

    Dim gla_path As String, gla_name As String, col As String, rowno As Integer, counter As Integer, lastrow As Integer

    MsgBox ("This VBA updates 'DC_Annual_Planning' by copying values from '4510_GLA501_DC'. Make sure to select the correct files!")
    gla_path = fnopen()
    gla_name = Right(gla_path, Len(gla_path) - InStrRev(gla_path, "\"))

    rowno = 16
    col = "F"

    lastrow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
    MsgBox lastrow

    MsgBox gla_name
    MsgBox getmat(rowno, col)
    MsgBox fcat(gla_path, gla_name, lastrow)

End Sub

1 个答案:

答案 0 :(得分:0)

是否找不到您搜索的价值,这就是造成问题的原因?

无论如何,在VBA工作时,我更喜欢使用Find而不是VLOOKUP。如果不审查代码的其余部分,并假设您遇到问题的行是lookFor.Offset(0, 79).Value = Application.VLookup(lookFor, srchRange, 2, False),则可以将其替换为:

Dim found_in_location As Range
Set found_in_location = srchRange.Columns(1).Find(What:=lookFor, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If Not found_in_location Is Nothing Then
  lookFor.Offset(0, 79).Value = found_in_location.Offset(0, 2)
Else
  ' What will you do if the value is not found?
End If

虽然占用的空间比VLOOKUP行多一点,但它更易于阅读和调试。