Question

我一直在努力使下面的代码工作，并且它昨天晚上做了，但不知怎的，今天早上打开Excel时它停止了运行。本质上，我正在使用vlookup宏来处理来自各种工作簿的重要数据，并且工作簿名称取决于该行的相应“标题”。首先，我用if语句检查文件是否确实存在;如果没有，我想突出标题单元格红色，然后移动到下一行进行相同的检查。如果文件确实存在，我想用适当的数据填充行，并用白色突出显示标题单元格。

在我的代码下面 - 如果你能看看并帮助我，我真的很感激！

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

Answer 1

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

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

Excel - 基于单元名称从多个工作簿中获取重要数据的宏

1 个答案: