如何解决VBA错误：隐藏模块中的编译错误
我有一个Excel文件，旨在简化工作场所（与客户）的流程
宏中的一个是在两个不同的选项卡之间匹配数据，执行一些计算，并在发现错误的粉色单元格中突出显示，以向最终用户突出显示该错误。大部分操作都是在数组内完成的，以提高速度（可能会存储大量数据）
此宏以及该工作簿上的所有其他宏在我的PC和我的PC上都运行良好。
但是，在将此文件发送给我们的某些客户后，他们报告说在运行我上面提到的宏时遇到了问题。他们分享了以下消息（下面的链接）：
'隐藏模块中的编译错误：............. 当代码与此应用程序的版本，平台或体系结构不兼容时，通常会发生此错误。
我已经读到这可能与32位和64位版本的Windows有关，并且可能需要更改代码以解决此问题。但是，我没有使用任何调用API的声明语句，也没有使用任何引用指针或处理程序的Long变量-所以我有点困惑可能导致此问题的原因。
请有人帮我弄清楚代码对我来说还行的时候，是什么原因导致其他PC上出现此错误消息？
Sub RefreshData()
'Set Variables
Dim fd As Worksheet
Dim ld As Worksheet
Dim OrN As Worksheet
Dim RF As Worksheet
Set fd = ThisWorkbook.Sheets("Feeder Data")
Set ld = ThisWorkbook.Sheets("Live Data")
Set OrN = ThisWorkbook.Sheets("Order Numbers")
Set RF = ThisWorkbook.Sheets("reference")
Dim PeriodReturnRange As Range
Dim YearReturnRange As Range
Dim DateLookUpRange As Range
Set PeriodReturnRange = RF.Range("K3:K200")
Set YearReturnRange = RF.Range("I3:I200")
Set DateLookUpRange = RF.Range("J3:J200")
Dim fdArray() As String
Dim ldArray() As String
Dim OrNArray() As String
Dim ldArray2() As String
'' 1) Set the size of the Feeder Data Array
On Error GoTo ErrorMsgfd
ReDim Preserve fdArray(6 To fd.Range("C" & Rows.Count).End(xlUp).Row,3 To 14)
On Error GoTo 0
'' 2) Set size of Live Data Array
On Error GoTo ErrorMsgld
ReDim Preserve ldArray(10 To ld.Range("B" & Rows.Count).End(xlUp).Row,2 To 28)
On Error GoTo 0
'' 3) Set Size of Order Number Array
On Error GoTo ErrorMsgOrN
ReDim Preserve OrNArray(8 To OrN.Range("J" & Rows.Count).End(xlUp).Row,8 To 10)
On Error GoTo 0
''4) Set size of second Order Number to get info needed for saving calculation
On Error GoTo ErrorMsgld
ReDim Preserve ldArray2(10 To ld.Range("B" & Rows.Count).End(xlUp).Row,14 To 22)
On Error GoTo 0
On Error GoTo PasswordErrorMsg
ld.Unprotect "password1234"
fd.Unprotect "password1234"
On Error GoTo 0
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
On Error Resume Next
ld.ShowAllData
fd.ShowAllData
On Error GoTo 0
''''Perform Worksheet Clearing and copy formatting down to row 5500
With ld
.Range("E4").Copy
.Range("B10:B5500").PasteSpecial xlPasteFormats
.Range("G10:G5500").PasteSpecial xlPasteFormats
.Range("J10:J5500").PasteSpecial xlPasteFormats
.Range("O10:P5500").PasteSpecial xlPasteFormats
.Range("S10:S5500").PasteSpecial xlPasteFormats
.Range("Z10:Z5500").PasteSpecial xlPasteFormats
.Range("AA10:AA5500").PasteSpecial xlPasteFormats
.Range("F4").Copy
.Range("C10:F5500").PasteSpecial xlPasteFormats
.Range("I10:I5500").PasteSpecial xlPasteFormats
.Range("K10:N5500").PasteSpecial xlPasteFormats
.Range("Q10:R5500").PasteSpecial xlPasteFormats
.Range("T10:V5500").PasteSpecial xlPasteFormats
.Range("AA10:AB5500").PasteSpecial xlPasteFormats
.Range("G4").Copy
.Range("H10:H5500").PasteSpecial xlPasteFormats
.Range("W10:Y5500").PasteSpecial xlPasteFormats
.Range("C10:F5500").ClearContents
.Range("I10:I5500").ClearContents
.Range("K10:N5500").ClearContents
.Range("Q10:R5500").ClearContents
.Range("T10:V5500").ClearContents
.Range("AA10:AB5500").ClearContents
End With
'''''''Populate Arrays
''4) Populate Feeder Data Array with the data
For A = 6 To fd.Range("C" & Rows.Count).End(xlUp).Row
For B = 3 To 14
fdArray(A,B) = Trim(fd.Cells(A,B))
Next B
Next A
''5) Populate Live Data Array
For A = 10 To ld.Range("B" & Rows.Count).End(xlUp).Row
For B = 2 To 28
ldArray(A,B) = Trim(ld.Cells(A,B))
Next B
Next A
'' 6) Populate Order Number Array
For A = 8 To OrN.Range("J" & Rows.Count).End(xlUp).Row
For B = 8 To 10
OrNArray(A,B) = Trim(OrN.Cells(A,B))
Next B
Next A
''''''''' Match the values between Live Data and Feeder Data arrays (still not transferring back to worksheet)
Dim LookUp1 As String
Dim LookUp2 As String
Dim LookUp3 As String
For A = 10 To UBound(ldArray)
LookUp1 = ldArray(A,2)
LookUp2 = ldArray(A,7)
On Error Resume Next
ldArray(A,11) = Application.WorksheetFunction.Lookup(CLng(CDate(ld.Range("J" & A).Value)),DateLookUpRange,PeriodReturnRange)
ldArray(A,22) = Application.WorksheetFunction.Lookup(CLng(CDate(ld.Range("J" & A).Value)),YearReturnRange)
On Error GoTo 0
For B = 6 To UBound(fdArray)
If fdArray(B,3) = LookUp1 And fdArray(B,9) = LookUp2 Then
On Error Resume Next
''Calculation 1
If fd.Range("H" & B).Value = "ABC" Then
ldArray(A,28) = fd.Range("N" & B).Value * (ld.Range("Z" & A).Value / 1000)
Else
ldArray(A,28) = fd.Range("N" & B).Value * (ld.Range("Z" & A).Value / 100)
End If
''Calculation 2
ldArray(A,17) = fd.Range("K" & B).Value - (ld.Range("O" & A).Value * fd.Range("L" & B).Value) - (ld.Range("P" & A).Value * fd.Range("M" & B).Value)
''Calculation 3
ldArray(A,18) = (ld.Range("O" & A).Value * fd.Range("L" & B).Value) + (ld.Range("P" & A).Value * fd.Range("M" & B).Value)
On Error GoTo 0
''''''''Lookup results
'Result 1
ldArray(A,3) = fdArray(B,4)
'Result 2
ldArray(A,4) = fdArray(B,5)
'Result 3
ldArray(A,5) = fdArray(B,6)
'Result 4
ldArray(A,6) = fdArray(B,7)
'Result 5
ldArray(A,9) = fdArray(B,8)
'Result 6
ldArray(A,13) = fdArray(B,10)
'Result 7
ldArray(A,14) = fdArray(B,11)
'Result 8
ldArray(A,20) = fdArray(B,12)
'Result 9
ldArray(A,21) = fdArray(B,13)
'Result 10
ldArray(A,27) = fdArray(B,14)
Exit For
End If
Next B
''Check for blanks,highlight that there has been an error if found
If ldArray(A,4) = "" Or ldArray(A,5) = "" Then
ld.Range("B" & A).Interior.Color = RGB(253,211,211)
ld.Range("G" & A).Interior.Color = RGB(253,211)
End If
''Check for blanks,11) = "" Or ldArray(A,22) = "" Then
ld.Range("J" & A).Interior.Color = RGB(253,211)
End If
Next A
''''Run a second loop between live data and order numbers,to match relevant order numbers
For A = 10 To UBound(ldArray)
LookUp1 = ldArray(A,7)
LookUp2 = ldArray(A,5)
For C = 8 To UBound(OrNArray)
''check if a particular special value was found and return matched result to array if it was,and ignore second lookup value
If LookUp1 = "xxx" And OrNArray(C,9) = "xxx" Then
ldArray(A,12) = OrNArray(C,10)
''IF special value not found,test against both lookup values''
Else
If OrNArray(C,9) = LookUp1 And OrNArray(C,8) = LookUp2 Then
ldArray(A,10)
Exit For
End If
End If
Next C
If ldArray(A,12) = "" Then
ld.Range("L" & A).Interior.Color = RGB(253,211)
End If
Next A
''7) Transfer the matched arrays to the Worksheet
ld.Range("B10",ActiveCell.Offset(UBound(ldArray,1) - 10,UBound(ldArray,2) - 23)).Value = ldArray
''''''''''Load second live data Array containing only relevant columns'''''''
For A = 10 To ld.Range("B" & Rows.Count).End(xlUp).Row
For B = 14 To 22
ldArray2(A,B) = ld.Cells(A,B)
Next B
Next A
''''''''''''Loop to check if a special condition has been met and color if needed'''''''''''''''''''''''''''''
For A = 10 To UBound(ldArray2)
With ld.Rows(A)
If ldArray2(A,19) = "" And ldArray2(A,14) = ldArray2(A,17) And _
Application.CountIfs(ld.Range("D10:D" & A),.Columns("D").Value,ld.Range("V10:V" & A),.Columns("V").Value,ld.Range("K10:K" & A),.Columns("K").Value) > 1 Then
.Columns("S").Interior.Color = RGB(253,211)
End If
End With
Next A
Erase fdArray
Erase ldArray
Erase OrNArray
Erase ldArray2
'''reset formatting of columns correctly,and unlock editable columns
With ld
.Range("B10:B5500").Locked = False
.Range("G10:H5500").Locked = False
.Range("J10:J5500").Locked = False
.Range("W10:Z5500").Locked = False
.Range("S10:S5500").Locked = False
.Range("O10:P5500").Locked = False
.Range("L10:L10000").NumberFormat = "@"
.Range("E10:E10000").NumberFormat = "@"
.Range("Q10:Q10000").NumberFormat = "0.00"
.Range("Z10:AB10000").NumberFormat = "0.00"
End With
'''array is being sent as text - this line required to make data format correctly - not sure why!
ld.Range("B10:AB5500").Select
Selection.Value = Selection.Value
ld.Range("B10").Select
On Error GoTo PasswordErrorMsg
ld.Protect "password1234",AllowFiltering:=True
fd.Protect "password1234",AllowFiltering:=True
On Error GoTo 0
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
Exit Sub
ErrorMsgfd:
MsgBox "No Data has been entered into the Feeder Data!",vbCritical,"Cannot Update"
Exit Sub
ErrorMsgld:
MsgBox "No Data has been entered into the Live Data!","Cannot Update"
Exit Sub
ErrorMsgOrN:
MsgBox "No Data has been entered into the Order Numbers!","Cannot Update"
Exit Sub
PasswordErrorMsg:
MsgBox "An incorrect password has been entered for this worksheet. Please change the password to the agreed text to continue!","Incorrect Password!!"
End Sub
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。