-1

I've been trying to make the below code work, and it did yesterday evening, but somehow this morning upon opening Excel it stopped functioning. Essentially, I'm using a vlookup macro to important data from various workbooks, and the workbook names depend on the respective "title" of that row. First, I check with an if statement whether the file actually exists; if it doesn't, I want to highlight the title cell red, and move onto the next row to carry out the same check. If the file does exist, I want to populate the row with the appropriate data and highlight the title cell with white colour.

Below my code - I'd really appreciate if you could take a look and help me out!

Public Function FileFolderExists(strFullPath As String) As Boolean

    On Error GoTo NextStep
    If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileFolderExists = True

NextStep:
    On Error GoTo 0
End Function

Private Sub CommandButton1_Click()

    Dim wsi As Worksheet
    Dim wse As Worksheet
    Dim j As Integer
    Dim i As Integer

    Set wsi = ThisWorkbook.Sheets("Income")
    Set wse = ThisWorkbook.Sheets("Expense")

    j = 3

    For i = 1 To 46

        If FileFolderExists(wsi.Cells(5, i + 2).Value & ".xlsx") Then
            wsi.Range(wsi.Cells(6, j), wsi.Cells(51, j)).Formula = "=VLOOKUP(index($B$6:$AV$51,row()-5,1),'[" & wsi.Cells(5, i + 2).Value & ".xlsx]Sheet1'!$A$1:$E$70,4,FALSE)"
            Sheets("Mark-Up Table").Cells(i + 5, 2).Interior.Color = RGB(255, 255, 255)
            Sheets("Mark-Up Table").Cells(5, i + 2).Interior.Color = RGB(255, 255, 255)
        Else
            Sheets("Mark-Up Table").Cells(i + 5, 2).Interior.Color = RGB(255, 0, 0)
            Sheets("Mark-Up Table").Cells(5, i + 2).Interior.Color = RGB(255, 0, 0)
        End If

        If FileFolderExists(wse.Cells(5, i + 2).Value & ".xlsx") Then
            wse.Range(wse.Cells(6, j), wse.Cells(51, j)).Formula = "=VLOOKUP(index($B$6:$AV$51,row()-5,1),'[" & wse.Cells(5, i + 2).Value & ".xlsx]Sheet2'!$A$1:$E$70,5,FALSE)"

        Else
            'do nothing
        End If

        j = j + 1

    Next i

End Sub
4

1 回答 1

0

我已经设法解决了这个问题。对于可能面临类似问题的人，请参阅以下内容：

Private Sub CommandButton1_Click()

    Dim strPath As String

    Dim wsi As Worksheet
    Dim wse As Worksheet

    Dim j As Integer
    Dim i As Integer

    Set wsi = ThisWorkbook.Sheets("Income")
    Set wse = ThisWorkbook.Sheets("Expense")

    strPath = Sheets("Mark-Up Table").Range("H3").Value

    j = 3

    For i = 1 To 46

        If Dir(strPath & wsi.Cells(i + 5, 2).Value & ".xlsx") = vbNullString Then
            Sheets("Mark-Up Table").Cells(i + 5, 2).Interior.Color = RGB(255, 0, 0)
            Sheets("Mark-Up Table").Cells(5, i + 2).Interior.Color = RGB(255, 0, 0)
        Else
            wsi.Range(wsi.Cells(3 + j, 3), wsi.Cells(3 + j, 48)).Formula = "=VLOOKUP(index($C$5:$AV$51,1,column()-2),'[" & wsi.Cells(i + 5, 2).Value & ".xlsx]Sheet1'!$A$1:$E$70,4,FALSE)"
            Sheets("Mark-Up Table").Cells(i + 5, 2).Interior.Color = RGB(255, 255, 255)
            Sheets("Mark-Up Table").Cells(5, i + 2).Interior.Color = RGB(255, 255, 255)
        End If

        If Dir(strPath & wse.Cells(5, i + 2).Value & ".xlsx") = vbNullString Then
            'do nothing
        Else
            wse.Range(wse.Cells(6, j), wse.Cells(51, j)).Formula = "=abs(VLOOKUP(index($B$6:$AV$51,row()-5,1),'[" & wse.Cells(5, i + 2).Value & ".xlsx]Sheet1'!$A$1:$E$70,5,FALSE))"
        End If

        j = j + 1

    Next i

End Sub
于 2013-06-25T14:56:16.723 回答