我制作了一个宏,其他人在过去 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