0

我制作了一个宏,其他人在过去 6 个月中一直在使用,直到昨天出现 0 个意外错误。

整个过程中,宏都是在 Office 365 中创建、编辑和使用的。所有操作系统都有 Windows 10。昨天有人尝试在另一台 PC(仍然是 Windows 10)上使用宏,但有 Excel 2016。他们使用宏导入一个文件并遇到Mismatch错误,错误行对我来说毫无意义,因为它只是擦除加载的数组。

我注释掉了擦除数组并再次尝试,它在我的代码的第一个 if 语句中给了我另一个不匹配错误。

我拿了完全相同的宏文件并在装有 Office 365 的 PC 上打开它,并且宏运行完美。

我不确定 2016 与 365 发生了什么,但我一直在阅读,我能找到的所有因素都与操作系统或项目参考有关。两者对我来说似乎都很好。

不确定这是否是有用的信息,但这些信息正在工作中使用,因此 PC 已联网

我错过了什么吗?任何建议都非常感谢!

错误

错误线

参考

****** 编辑 ******

Call OptimizeCode_Begin

Dim FileToOpen As Variant, ResultFile As Variant, xRet As Boolean, Name As String, SDInterpretation As Integer, CrtThresholdCutoff#
Dim QSResultFileWB As Workbook, QSResultFileWS As Worksheet, FormattingWS As Worksheet, ImptPtInfo As Worksheet, PullReruns As Worksheet
Dim SampleName As Range, QSTarget As Range, sampleArrayIK As Variant, sampleArrayDE As Variant, FormattingWBCrtLastRow As Long, FlaggedSpecimensLastRow As Long
Dim CrtAverage As Range, FlaggedSpecimens As Range, FinalResult As Range, FirstTarget As Range, SecondTarget As Range, AccessionNumber As Range
Dim FirstTargetCrtValue As Range, SecondTargetCrtValue As Range, CrtSDValue As Range, FinalCrt As Range, twenty As Integer
Dim NameChange As Range, NameChangeMatch As Variant, ElastRow As Long, UlastRow As Long, PreConvertedNames As Range, SampleNameLastRow As Long
Dim DEColumnRng As Range, IKColumnRng As Range, DLastRow As Long, QSNameMatch As Variant
Dim Counter As Long, SampleNameStart As Range, TotalRows As Integer, QCProblems As Range, QCProblemsLastRow As Long
Dim PostImportDLastRow As Long, EndPlateQSMatch As Variant, FindFullNameAndPosition As Range
Dim myPath As String, XenoControl As String, ColumnCRerunsLastRow As Long, ColumnBRerunsLastRow As Long
Dim ColumnBReruns As Range, ColumnCReruns As Range, RerunPatient As Range, RedBorderSearchRng As Range
Dim PositiveExtractionControl As String, NegativeExtractionControl As String, NegativeTemplateControl As String, PositiveTemplateControl5 As String
Dim NTCArr As Variant, PTC5Arr As Variant, PEC1Arr As Variant, NEC1Arr As Variant
Dim DERange As Range, IJKRange As Range, r As Range, ClearStartRangeLastRow As Long, ClearStartRange As Range
Dim SerialNumberRng As Range, OpenArraySerialNumber As String, PlateSerialNumber As Range

Dim LowLow As String, Low As String, Moderate As String, High As String, HighHigh As String, EstCopyNumber As Range
Dim PTC123Arr As Variant, PTC4Arr As Variant, PositiveTemplateControl2 As String, PositiveTemplateControl3 As String, PositiveTemplateControl4 As String, PositiveTemplateControl1 As String

    ChDrive "C"
    myPath = "C:\Users\j\OneDrive\Documents\Excel\UTM Open Array\Validation Files"   
    ChDir myPath

    PositiveExtractionControl = "PEC"
    NegativeExtractionControl = "NEC"
    NegativeTemplateControl = "NTC"
    PositiveTemplateControl5 = "PTC"

LowLow = "< 1,000 copies/uL (Low)"
Low = "1,000 - 10,000 copies/uL (Low)"
Moderate = "10,000 - 100,000 copies/uL (Moderate)"
High = "100,000 - 1,000,000 copies/uL (High)"
HighHigh = "> 1,000,000 copies/uL (High)"

        PEC1Arr = Array("Candida albicans", "Xeno")
        NEC1Arr = Array("Xeno")
        NTCArr = Array("Proteus vulgaris", "Acinetobacter baumannii", "Klebsiella pneumoniae", "Pseudomonas aeruginosa", "Klebsiella oxytoca", "Enterobacter cloacae", _
                        "Enterococcus faecium", "Morganella morganii", "Providencia stuartii", "Citrobacter freundii", "Streptococcus agalactiae", "Enterococcus faecalis", _
                        "Escherichia coli", "Klebsiella aerogenes", "Coagulase-negative staphylococcus", "Candida albicans", "Xeno", "Proteus mirabilis", _
                        "ESBL", "DHA", "ampC/FOX/ACC", "IMP", "TEM/SHV/VEB", "OXA/GES/PER", "qnrA/qnrS", "OXA", "VIM/KPC", "Vancomycin")
        PTC5Arr = Array("Proteus vulgaris", "Acinetobacter baumannii", "Klebsiella pneumoniae", "Pseudomonas aeruginosa", "Klebsiella oxytoca", "Enterobacter cloacae", _
                        "Enterococcus faecium", "Morganella morganii", "Providencia stuartii", "Citrobacter freundii", "Streptococcus agalactiae", "Enterococcus faecalis", _
                        "Escherichia coli", "Klebsiella aerogenes", "Coagulase-negative staphylococcus", "Candida albicans", "Xeno", "Proteus mirabilis", _
                        "ESBL", "DHA", "ampC/FOX/ACC", "IMP", "TEM/SHV/VEB", "OXA/GES/PER", "qnrA/qnrS", "OXA", "VIM/KPC", "Vancomycin")

        Set FormattingWS = ThisWorkbook.Sheets("OpenArray Raw Data")

 FileToOpen = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLSX), *.XLSX", Title:="Select all files needing analyzed", MultiSelect:=True)       'if file types change to csv or something else, this needs changed
        If Not IsArray(FileToOpen) Then Exit Sub

                'clear import range
        With FormattingWS
            ClearStartRangeLastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
            Set ClearStartRange = FormattingWS.Range("D11:O" & ClearStartRangeLastRow)
            ClearStartRange.Clear
            .Range("A3:C500").Clear
        End With

        With FormattingWS
            .Range("D10").Value = "Sample Name"
            .Range("E10").Value = "Target Name"
            .Range("F10").Value = "Crt"
            .Range("G10").Value = "Crt Average"
            .Range("H10").Value = "Crt SD"
            .Range("I10").Value = "Serial Number"
            .Range("M10").Value = "Final Result"
            .Range("N10").Value = "Final Crt"
            .Range("O10").Value = "Estimated Copy Number"
            With FormattingWS.Range("D10:O10")
                .Font.Size = 14
                .Font.Bold = True
            End With
        End With

                'select all result files at once
        For Each ResultFile In FileToOpen   '---------------------------------Import Result Files (Start)----------------------------
            Set QSResultFileWB = Workbooks.Open(ResultFile)
            Set QSResultFileWS = QSResultFileWB.Sheets("Results")

            TotalRows = 0
            Counter = 0

            With QSResultFileWS
                Set SampleName = .Range("A1:Q50").Find("Sample Name")
                SampleNameLastRow = .Cells(.Rows.Count, SampleName.Column).End(xlUp).Row
                Set SampleNameStart = .Range("D" & SampleName.Row).Offset(1, 0)

                With QSResultFileWS.Range("D" & SampleNameStart.Row, "D" & SampleNameLastRow)
                    For Each r In .Rows
                        If r.Value = vbNullString Then
                            GoTo CountNextRow
                        End If
                        If Application.CountA(r) <> 0 Then
                            Counter = Counter + 1
                        End If
CountNextRow:       Next r
                TotalRows = Counter
                End With
                OpenArraySerialNumber = QSResultFileWS.Range("B1").Value
                Set DERange = .Range("D21:E" & SampleNameLastRow)
                Set IJKRange = .Range("I21:I" & SampleNameLastRow)
                sampleArrayDE = DERange.Worksheet.Evaluate("FILTER(" & DERange.Address & "," & DERange.Columns(1).Address & "<>"""")")
                sampleArrayIK = IJKRange.Worksheet.Evaluate("FILTER(" & IJKRange.Address & "," & DERange.Columns(1).Address & "<>"""")")
            End With

            With FormattingWS
                DLastRow = FormattingWS.Cells(Rows.Count, "D").End(xlUp).Row
                Set DEColumnRng = FormattingWS.Range("D" & DLastRow).Offset(1, 0)
                Set IKColumnRng = FormattingWS.Range("F" & DLastRow).Offset(1, 0)
                Set SerialNumberRng = FormattingWS.Range("I" & DLastRow).Offset(1, 0)
                FormattingWS.Range(DEColumnRng, "E" & (DEColumnRng.Row + TotalRows) - 1).Value = sampleArrayDE
                FormattingWS.Range(IKColumnRng, "F" & (DEColumnRng.Row + TotalRows) - 1).Value = sampleArrayIK
                FormattingWS.Range(SerialNumberRng, "I" & (DEColumnRng.Row + TotalRows) - 1).Value = OpenArraySerialNumber
            End With
                Erase sampleArrayDE
                Erase sampleArrayIK
            QSResultFileWS.Parent.Close False
        Next ResultFile                     '---------------------------------Import Result Files (End)-------------------------------

        Set ImptPtInfo = ThisWorkbook.Worksheets("Import Patient Information")
        Set PullReruns = ThisWorkbook.Worksheets("Reruns To Pull")

        With PullReruns             '------------------------------Set Location on Reruns To Pull for Inconclusives + Reruns (Start)----------------------------------------
            .Range("A7:F2500").Clear
                ColumnBRerunsLastRow = PullReruns.Cells(Rows.Count, "C").End(xlUp).Row
                ColumnCRerunsLastRow = PullReruns.Cells(Rows.Count, "F").End(xlUp).Row
            Set ColumnBReruns = PullReruns.Range("C" & ColumnBRerunsLastRow).Offset(1, -2)
            Set ColumnCReruns = PullReruns.Range("F" & ColumnCRerunsLastRow).Offset(1, -2)
        End With                    '------------------------------Set Location on Reruns To Pull for Inconclusives + Reruns (End)----------------------------------------

        With FormattingWS
            FormattingWBCrtLastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
            ElastRow = .Cells(.Rows.Count, "E").End(xlUp).Row
            UlastRow = .Cells(.Rows.Count, "U").End(xlUp).Row
        Set PreConvertedNames = .Range("U1:U" & UlastRow)
            QCProblemsLastRow = .Cells(Rows.Count, "C").End(xlUp).Row       'change this to Columns A B and C
        Set QCProblems = .Range("C" & QCProblemsLastRow).Offset(1, 0)
            PostImportDLastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
        Set RedBorderSearchRng = FormattingWS.Range("D1:D" & PostImportDLastRow).Cells
        End With
        With FormattingWS.Range("D11:E" & PostImportDLastRow, "M11:M" & PostImportDLastRow)
            .NumberFormat = "@"
        End With
        With FormattingWS.Range("F11:H" & PostImportDLastRow, "N11:N" & PostImportDLastRow)
            .NumberFormat = "0.00"
        End With
        
        For Each NameChange In FormattingWS.Range("E11:E" & ElastRow).Cells     '-----------------------------Translate Target Names (Start)---------------------------------------
            NameChangeMatch = Application.Match(NameChange.Value, PreConvertedNames, 0) 'use helper columns in columns U and V on destination workbook to match/change names of everything in column e
                If Not IsError(NameChangeMatch) Then
                    With NameChange
                        .Value = FormattingWS.Cells(NameChangeMatch, 22)
                    End With
                End If
        Next NameChange                                                         '-----------------------------Translate Target Names (End)-----------------------------------------
        
        XenoControl = FormattingWS.Range("V28").Value
        SDInterpretation = 2        'if both target crt values are numbers then the SD must be <= 2.00 in order to be called detected
        twenty = 20
        
        For Each CrtAverage In FormattingWS.Range("G11:G" & FormattingWBCrtLastRow).Cells       '----------------------Result Interpretation Conditions(Start)--------------------------------------
           
           Set FirstTarget = CrtAverage.Offset(0, -2)
           Set SecondTarget = CrtAverage.Offset(1, -2)
           Set FirstTargetCrtValue = CrtAverage.Offset(0, -1)
           Set SecondTargetCrtValue = CrtAverage.Offset(1, -1)
           Set FinalResult = CrtAverage.Offset(0, 6)
           Set PlateSerialNumber = CrtAverage.Offset(0, 2)
           Set CrtSDValue = CrtAverage.Offset(0, 1)
           Set FinalCrt = CrtAverage.Offset(0, 7)
           Set AccessionNumber = CrtAverage.Offset(0, -3)
           Set EstCopyNumber = CrtAverage.Offset(0, 8)
        
            If FirstTarget.Value = SecondTarget.Value Then            'check 2 columns to the left, if this target and the target directly below are the same then
                    If FirstTarget.Value = "Coagulase-negative staphylococcus" Or FirstTarget.Value = "Xeno" Then
                        CrtThresholdCutoff# = 27.01
                    Else
                        CrtThresholdCutoff# = 30.01
                    End If
                If FirstTargetCrtValue.Value = "Undetermined" And SecondTargetCrtValue.Value = "Undetermined" Then
                    With FinalResult
                        .Value = "Not Detected"
                    End With
                    With FinalCrt
                        .Value = "0"
                    End With
                ElseIf IsNumeric(FirstTargetCrtValue.Value) = True And IsNumeric(SecondTargetCrtValue.Value) = True Then
                    With CrtAverage
                        .Value = Application.Average(FirstTargetCrtValue, SecondTargetCrtValue)
                    End With
                    With CrtSDValue
                        .Value = Application.WorksheetFunction.StDev(FirstTargetCrtValue, SecondTargetCrtValue)
                    End With
                    If (FirstTargetCrtValue.Value <= CrtThresholdCutoff) And (SecondTargetCrtValue.Value <= CrtThresholdCutoff) Then
                        With FinalCrt
                            .Value = (CrtAverage.Value + CrtSDValue.Value)
                        End With
                        If FinalCrt.Value <= CrtThresholdCutoff Then
                            With FinalResult
                                .Value = "Detected"
                                .Interior.Color = RGB(0, 255, 0)
                            End With
                        ElseIf FinalCrt.Value > CrtThresholdCutoff Then
                            With FinalResult
                                .Value = "Not Detected"
                            End With
                            With FinalCrt
                                .Value = "0"
                            End With
                        End If
                    ElseIf (FirstTargetCrtValue.Value <= CrtThresholdCutoff And SecondTargetCrtValue.Value > CrtThresholdCutoff) Or _
                            (FirstTargetCrtValue.Value > CrtThresholdCutoff And SecondTargetCrtValue.Value <= CrtThresholdCutoff) Then
                        With FinalCrt
                            .Value = (CrtAverage.Value + CrtSDValue.Value)
                        End With
                        
                        If (FinalCrt.Value <= CrtThresholdCutoff And CrtSDValue.Value <= SDInterpretation) Then
                            With FinalResult
                                .Value = "Detected"
                                .Interior.Color = RGB(0, 255, 0)
                            End With
                        ElseIf (FinalCrt.Value > CrtThresholdCutoff And CrtSDValue.Value <= SDInterpretation) Then
                            With FinalResult
                                .Value = "Not Detected"
                            End With
                            With FinalCrt
                                .Value = "0"
                            End With
                        ElseIf (FinalCrt.Value <= CrtThresholdCutoff And CrtSDValue.Value > SDInterpretation) Then
                            With FinalResult
                                .Value = "Not Detected"
                            End With
                            With FinalCrt
                                .Value = "0"
                            End With
                        End If
                    ElseIf (FirstTargetCrtValue.Value > CrtThresholdCutoff And SecondTargetCrtValue.Value > CrtThresholdCutoff) Then
                        With FinalCrt
                            .Value = "0"
                        End With
                        With FinalResult
                            .Value = "Not Detected"
                        End With
                    End If
                ElseIf IsNumeric(FirstTargetCrtValue.Value) = True And IsNumeric(SecondTargetCrtValue.Value) = False Then
                    With CrtAverage
                        .Value = Application.Average(FirstTargetCrtValue.Value, 0) 'find average of firsttargetcrtvalue & 0 (Undetermined)
                    End With
                    With CrtSDValue
                        .Value = Application.WorksheetFunction.StDev(FirstTargetCrtValue.Value, 0)
                    End With
                    If FirstTargetCrtValue.Value <= twenty And (AccessionNumber.Value <> PositiveExtractionControl And AccessionNumber.Value <> NegativeExtractionControl _
                        And AccessionNumber.Value <> NegativeTemplateControl And AccessionNumber.Value <> PositiveTemplateControl5) Then
                        With FinalCrt
                            .Value = "500"                                             'place 0 so specimen does not look like a positive in Ligo
                        End With
                        With FinalResult
                            .Value = "Inconclusive"
                            .Interior.Color = RGB(255, 255, 0)
                        End With
                        
                        PatientRerun (AccessionNumber & "," & FirstTarget)
                        
                    ElseIf FirstTargetCrtValue.Value <= twenty And (AccessionNumber.Value = PositiveExtractionControl Or AccessionNumber.Value = NegativeExtractionControl _
                            Or AccessionNumber.Value = NegativeTemplateControl Or AccessionNumber.Value = PositiveTemplateControl5) Then
                        With FinalResult
                            .Value = "Inconclusive"
                            .Interior.Color = RGB(255, 255, 0)
                        End With
                        With FinalCrt
                            .Value = "500"
                        End With
                    ElseIf FirstTargetCrtValue.Value > twenty Then
                            With FinalResult
                                .Value = "Not Detected"
                            End With
                            With FinalCrt
                                .Value = "0"
                            End With
                    End If
                ElseIf IsNumeric(FirstTargetCrtValue.Value) = False And IsNumeric(SecondTargetCrtValue.Value) = True Then
                    With CrtAverage
                        .Value = Application.Average(SecondTargetCrtValue, 0)
                    End With
                    With CrtSDValue
                        .Value = Application.WorksheetFunction.StDev(SecondTargetCrtValue, 0)
                    End With
                    If SecondTargetCrtValue.Value <= twenty And (AccessionNumber.Value <> PositiveExtractionControl) And (AccessionNumber.Value <> NegativeExtractionControl) _
                        And (AccessionNumber.Value <> NegativeTemplateControl) And (AccessionNumber.Value <> PositiveTemplateControl5) Then
                        With FinalCrt
                            .Value = "500"
                        End With
                        With FinalResult
                            .Value = "Inconclusive"
                            .Interior.Color = RGB(255, 255, 0)
                        End With
                        
                        PatientRerun (AccessionNumber & "," & FirstTarget)
                        
                    ElseIf SecondTargetCrtValue.Value <= twenty And (AccessionNumber.Value = PositiveExtractionControl Or AccessionNumber.Value = NegativeExtractionControl _
                            Or AccessionNumber.Value = NegativeTemplateControl Or AccessionNumber.Value = PositiveTemplateControl5) Then
                        With FinalResult
                            .Value = "Inconclusive"
                            .Interior.Color = RGB(255, 255, 0)
                        End With
                        With FinalCrt
                            .Value = "500"
                        End With
                    ElseIf SecondTargetCrtValue.Value > twenty Then
                        With FinalResult
                            .Value = "Not Detected"
                        End With
                        With FinalCrt
                            .Value = "0"
                        End With
                    End If
                End If
                If (FirstTarget = "Xeno" And FinalResult <> "Detected" And AccessionNumber <> PositiveExtractionControl And AccessionNumber <> NegativeExtractionControl _
                    And AccessionNumber <> PositiveTemplateControl5 And AccessionNumber <> NegativeTemplateControl) Then
                    PatientRerun (AccessionNumber & "," & FirstTarget)
                End If

整个 sub 太长了,但是在注释掉删除数组后发生错误的 if 语句是If FirstTarget.Value = "Coagulase-negative staphylococcus" Or FirstTarget.Value = "Xeno" Then

4

1 回答 1

1

Erase sampleArrayDE如果sampleArrayDE没有与以下兼容的类型,则会因“类型不匹配”而失败Erase

https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/erase-statement

Erase可以在固定大小的数组上调用,或者在具有 Array 子类型的 Variant 上调用,所以在这种情况下TypeName(sampleArrayDE)应该给你Variant()

如果它不是这些类型之一,那么可能是因为您的 FILTER() 调用未能返回任何记录,在这种情况下TypeName()将是Error,这与Erase

值得注意的是,FILTER() 在 Excel 2016 中不可用,我应该早点使用它...

于 2021-10-10T00:59:29.120 回答