打墙。如何在公式VBA中查找问题

时间:2019-07-02 21:47:31

标签: excel vba formula

这是我第一次尝试编码,但我碰到了一个点,就是无法弄清楚,因此非常灰心。我试图获取公式以检查wsReference,并且如果在两张纸上都存在三个单元格匹配的行,则在满足我的数量条件的情况下,它将把字符串放入“ fillinCell”(列c)中。我似乎已经消除了很多错误,但是现在当我运行代码时,它只是打开了wsReference而没有任何其他反应。

几天前我才刚刚开始学习VBA,所以我不太了解如何解决此问题。我从未遇到调试器无法识别的问题。

Sub Openfile()

    Dim wbOracle As Workbook
    Set wbOracle = ThisWorkbook

    Dim FileToOpen As Variant

    FileToOpen = Application.GetOpenFilename(FileFilter:="Excel Workbooks (*.xls*),*.xls*", Title:="Open Database File")
    If FileToOpen = False Then
    MsgBox "No file selected, cannot continue." 'If the user does not open a file this message is displayed
    Exit Sub 'If no file is selected the program stops running
    End If

    Dim wbReference As Workbook
    Set wbReference = Workbooks.Open(FileToOpen)
    Workbooks.Open (FileToOpen) 'If a file is selected it opens that file.

    LoopTest1 wbOracle, wbReference

End Sub

Sub LoopTest1(ByRef wbOracle As Workbook, ByRef wbReference As Workbook)

    Dim wsOracle As Worksheet
    Set wsOracle = wbOracle.Worksheets(1)

    Dim wsReference As Worksheet
    Dim referenceCell As Range
    Set wsReference = wbReference.Worksheets(1)
    Set referenceCell = wsOracle.Range("E16")

    Set fillinCell = wsOracle.Range("C16")

 Dim formulaText As String
    Do While Not IsEmpty(referenceCell)
        formulaText = "=IF(INDEX('[" & wbReference.Name & "]Worksheets(1)'!$A$2000:$M$2000,MATCH(1,(['" & wbReference.FullName & "]Worksheets(1)'!D:D=['" & wbOracle.FullName & "]" & wsOracle.Name & "'!E16)*('[" & wbReference.FullName & "]Worksheets(1)!E:E=[" & wbOracle.FullName & "]" & wsOracle.Name & "'!'I16')*([" & wbReference.FullName & "]Worksheets(1)!F:F=[" & wbOracle.FullName & "]" & wsOracle.Name & "'!'J16'),0),9)>=[" & wbOracle.FullName & "]" & wsOracle.Name & "'!M:M, ""materials supplied"","""")"
        fillinCell.Formula = formulaText
        Set referenceCell = referenceCell.Offset(1, 0)
        Set fillinCell = fillinCell.Offset(1, 0)
    Loop
End Sub

0 个答案:

没有答案