本文介绍了Visual Basic COMException错误的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我有一些VBA代码，可以根据特定的列来查找excel中的重复行。我试图将其转换为VB，但是收到错误：COMException未处理
HRESULT异常：0x800A0005（CTL_E_ILLEGALFUNCTIONCALL）
我得到这个行如果includedColumns.Exists（j）Then。
代码是：
Public Sub btnRun_Click（sender As System.Object，e As System.EventArgs）处理btnRun。点击
Dim xlApp As Excel.Application
Dim xlWorkBook1 As Excel.Workbook'Interactions
Dim xlWorkBooks As Excel.Workbooks
Dim MainSheet1 As Excel。工作表
xlApp =新的Excel.Application
xlWorkBooks = xlApp.Workbooks
xlWorkBook1 = xlWorkBooks.Open（File1_name）
MainSheet1 = xlWorkBook1.Sheets 1）
Dim InteractionRows As Long = MainSheet1.UsedRange.Rows.Count交互工作表中的总行数
Dim totalURCols As Long = MainSheet1.UsedRange.Columns.Count'最后一次使用col对于重复的问题calc
'重复发行---------------------------------- -------------------------------------------------- ----
Const LAST_COL As Long = 40'更新最后一列+ 1（即更新第41列，AO）
Const FIRST_ROW As Long = 2'数据开始的行，即不包括头
Const FIRST_COL As Long = 1'数据开始的行
Const dupe As String =1 '这将是标志
Const CASE_SENSITIVE As Byte = 1'匹配UPPER&低
Dim searchRng As Range'搜索范围
Dim memArr As Object
Dim i As Long
Dim j As Long
Dim unique As String
Dim includedColumns As New Scripting.Dictionary'为要用作重复问题搜索条件的列定义存储。从Microsoft Scripting Runtime库创建一个字典（存储方法）
Dim valDict作为New Scripting.Dictionary'大写和小写比较
With includedColumns'将以下列添加到字典
.Add（4，）'创建日期
.Add（8， ）'<<<<<<<<<<< <<<<<<<<<<< col 8（H）CALL_TYPE as duplicate issue criteria
.Add（10，）'<<<<<<< ;<<<<<<<<<<<<<<<<<<< col 10（J）IT_Service作为重复发行标准
.Add（11，）'<<<<<<< ;<<<<<<<<<<<<<<<<<<< col 11（K）Business_Service作为重复发行标准
.Add（21，）'<<<<<<< ;<<<<<<<<<<<<<<<<<<< col 21（U）Affected_Staff_Id作为重复的问题标准
结束
唯一= vbNullString
如果CASE_SENSITIVE = 1然后
valDict.CompareMode = vbBinaryCompare
Else
valDict.CompareMode = vbTextCompare
End If
'标志创建
searchRng = MainSheet1.Range（MainSheet1.Cells（FIRST_ROW，FIRST_COL），_
MainSheet1.Cells InteractionRows，LAST_COL））
如果LAST_COL< totalURCols然后
MainSheet1.Range（MainSheet1.Cells（FIRST_ROW，LAST_COL + 1），_
MainSheet1.Cells（FIRST_ROW，totalURCols））。EntireColumn.Delete（）'删除任何额外的列
结束如果
memArr = searchRng.Resize（InteractionRows，LAST_COL + 1）'整个范围，数据为mem
对于i = 1对于InteractionRows的每行，没有标题
对于j = 1到LAST_COL'每个col
如果includedColumns.Exists（j）Then
unique = unique& searchRng（i，j）'同一行的连接值
End If
Next
如果valDict.Exists（unique）然后'检查整行是否存在
memArr（i，LAST_COL + 1）= dupe'如果是，则将其标记在最后一列col
Else
valDict.Add（Key：= unique，Item：= i）'否则将其添加到字典
memArr （i，LAST_COL + 1）=0
End If
unique = vbNullString
Next
End Sub
结束类
解决方案 p>使用通用字典的类似方法 Public Sub btnRun_Click（sender As System.Object，e As System.EventArgs）处理btnRun 。
Dim xlApp As Excel.Application
Dim xlWorkBook1 As Excel.Workbook'Interactions
Dim xlWorkBooks As Excel.Workbooks
Dim MainSheet1 As Excel .Worksheet
xlApp = New Excel.Application
xlWorkBooks = xlApp.Workbooks
xlWorkBook1 = xlWorkBooks.Open（File1_name）
MainSheet1 = xlWorkBook1.Sheets（1）
Dim InteractionRows As Long = MainSheet1.UsedRange.Rows.Count交互工作表中的总行数
Dim totalURCols As Long = MainSheet1.UsedRange.Columns.Count'最后一次使用的列表中的重复问题calc
'重复发行------------------------------------------- ---------------------------------------------
Const LAST_COL As Long = 40'更新最后一列+ 1（即。将更新第41列，AO）
Const FIRST_ROW As Long = 2'数据开始的行，即不包括头
Const FIRST_COL As Long = 1'数据开始的行
Const dupe As String =1'这将是标志
Const CASE_SENSITIVE As Byte = 1'匹配UPPER&低
Dim searchRng As Range'搜索范围
Dim memArr As Object
Dim i As Long
Dim j As Long
Dim unique As String
Dim includedColumns As New Dictionary（Of Long，Object）'定义要用作重复问题搜索条件的列的存储。从Microsoft Scripting Runtime库创建一个字典（存储方法）
Dim valDict As New Dictionary（Of String，Long）'用于大写和小写比较
With includedColumns'将以下列添加到字典
.Add（4，）'创建日期$ （8，）'& <<<<<<<<<<<<<<< col 8（H）CALL_TYPE as duplicate issue criteria
.Add（10，）'<<<<<<< ;<<<<<<<<<<<<<<<<<<< col 10（J）IT_Service作为重复发行标准
.Add（11，）'<<<<<<< ;<<<<<<<<<<<<<<<<<<< col 11（K）Business_Service作为重复发行标准
.Add（21，）'<<<<<<< ;<<<<<<<<<<<<<<<<<<< col 21（U）Affected_Staff_Id作为重复的问题标准
结束与
unique = vbNullString
'如果CASE_SENSITIVE = 1然后
'valDict.CompareMode = vbBinaryCompare
'Else
'valDict.CompareMode = vbTextCompare
'End If
'标志创建
searchRng = MainSheet1.Range（MainSheet1.Cells（FIRST_ROW，FIRST_COL），_
MainSheet1.Cells（InteractionRows，LAST_COL））
如果LAST_COL< totalURCols然后
MainSheet1.Range（MainSheet1.Cells（FIRST_ROW，LAST_COL + 1），_
MainSheet1.Cells（FIRST_ROW，totalURCols））。EntireColumn.Delete（）'删除任何额外的列
结束如果
memArr = searchRng.Resize（InteractionRows，LAST_COL + 1）'整个范围，数据为mem
对于i = 1对于InteractionRows的每行，没有标题
对于j = 1到LAST_COL'每个col
如果includedColumns.ContainsKey（j）Then
unique = unique& searchRng（i，j）'同一行的连接值
End If
Next
如果valDict.ContainsKey（unique）然后'检查整行是否存在
memArr（i，LAST_COL + 1）= dupe'，如果是，则将其标记在最后一列col
Else
valDict.Add（unique，i）'else将其添加到字典
memArr（i，LAST_COL + 1 ）=0
结束如果
unique = vbNullString
下一个
End Sub
Hi I have some VBA code that searches for duplicate rows in excel based on specific columns to look at. I am attempting to convert it to VB however am getting the error:COMException was unhandledException from HRESULT: 0x800A0005 (CTL_E_ILLEGALFUNCTIONCALL)
I get this on the line "If includedColumns.Exists(j) Then".Code is:
Public Sub btnRun_Click(sender As System.Object, e As System.EventArgs) Handles btnRun.Click
Dim xlApp As Excel.Application
Dim xlWorkBook1 As Excel.Workbook ' Interactions
Dim xlWorkBooks As Excel.Workbooks
Dim MainSheet1 As Excel.Worksheet
xlApp = New Excel.Application
xlWorkBooks = xlApp.Workbooks
xlWorkBook1 = xlWorkBooks.Open(File1_name)
MainSheet1 = xlWorkBook1.Sheets(1)
Dim InteractionRows As Long = MainSheet1.UsedRange.Rows.Count ' Total number of rows in the Interaction worksheet
Dim totalURCols As Long = MainSheet1.UsedRange.Columns.Count ' get last used col on sheet for duplicate issue calc
' For Duplicate Issue ----------------------------------------------------------------------------------------
Const LAST_COL As Long = 40 ' Update last column + 1 (ie. will update the 41th column, AO)
Const FIRST_ROW As Long = 2 ' The row the data starts, ie not including the header
Const FIRST_COL As Long = 1 ' The row the data starts
Const dupe As String = "1" ' This will be the flag
Const CASE_SENSITIVE As Byte = 1 ' Matches UPPER & lower
Dim searchRng As Range ' Search Range
Dim memArr As Object
Dim i As Long
Dim j As Long
Dim unique As String
Dim includedColumns As New Scripting.Dictionary ' Define storage for the columns you want to be used as duplicate issue search criteria.Create a Dictionary (a storage method) from the Microsoft Scripting Runtime library
Dim valDict As New Scripting.Dictionary ' For Upper and Lower case comparison
With includedColumns ' Add the following columns to the Dictionary
.Add(4, "") ' Creation date
.Add(8, "") ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< col 8 (H) CALL_TYPE as duplicate issue criteria
.Add(10, "") ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< col 10 (J) IT_Service as duplicate issue criteria
.Add(11, "") ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< col 11 (K) Business_Service as duplicate issue criteria
.Add(21, "") ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< col 21 (U) Affected_Staff_Id as duplicate issue criteria
End With
unique = vbNullString
If CASE_SENSITIVE = 1 Then
valDict.CompareMode = vbBinaryCompare
Else
valDict.CompareMode = vbTextCompare
End If
' Flag Creation
searchRng = MainSheet1.Range(MainSheet1.Cells(FIRST_ROW, FIRST_COL), _
MainSheet1.Cells(InteractionRows, LAST_COL))
If LAST_COL < totalURCols Then
MainSheet1.Range(MainSheet1.Cells(FIRST_ROW, LAST_COL + 1), _
MainSheet1.Cells(FIRST_ROW, totalURCols)).EntireColumn.Delete() 'delete any extra columns
End If
memArr = searchRng.Resize(InteractionRows, LAST_COL + 1) 'entire range with data to mem
For i = 1 To InteractionRows 'each row, without the header
For j = 1 To LAST_COL 'each col
If includedColumns.Exists(j) Then
unique = unique & searchRng(i, j) 'concatenate values on same row
End If
Next
If valDict.Exists(unique) Then 'check if entire row exists
memArr(i, LAST_COL + 1) = dupe 'if it does, flag it in last col
Else
valDict.Add(Key:=unique, Item:=i) 'else add it to the dictionary
memArr(i, LAST_COL + 1) = "0"
End If
unique = vbNullString
Next
End Sub
End Class
Any assistance would be greatly appreciated.
解决方案 A similar approach using Generic Dictionary
Public Sub btnRun_Click(sender As System.Object, e As System.EventArgs) Handles btnRun.Click
Dim xlApp As Excel.Application
Dim xlWorkBook1 As Excel.Workbook ' Interactions
Dim xlWorkBooks As Excel.Workbooks
Dim MainSheet1 As Excel.Worksheet
xlApp = New Excel.Application
xlWorkBooks = xlApp.Workbooks
xlWorkBook1 = xlWorkBooks.Open(File1_name)
MainSheet1 = xlWorkBook1.Sheets(1)
Dim InteractionRows As Long = MainSheet1.UsedRange.Rows.Count ' Total number of rows in the Interaction worksheet
Dim totalURCols As Long = MainSheet1.UsedRange.Columns.Count ' get last used col on sheet for duplicate issue calc
' For Duplicate Issue ----------------------------------------------------------------------------------------
Const LAST_COL As Long = 40 ' Update last column + 1 (ie. will update the 41th column, AO)
Const FIRST_ROW As Long = 2 ' The row the data starts, ie not including the header
Const FIRST_COL As Long = 1 ' The row the data starts
Const dupe As String = "1" ' This will be the flag
Const CASE_SENSITIVE As Byte = 1 ' Matches UPPER & lower
Dim searchRng As Range ' Search Range
Dim memArr As Object
Dim i As Long
Dim j As Long
Dim unique As String
Dim includedColumns As New Dictionary(Of Long, Object) ' Define storage for the columns you want to be used as duplicate issue search criteria.Create a Dictionary (a storage method) from the Microsoft Scripting Runtime library
Dim valDict As New Dictionary(Of String, Long) ' For Upper and Lower case comparison
With includedColumns ' Add the following columns to the Dictionary
.Add(4, "") ' Creation date
.Add(8, "") ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< col 8 (H) CALL_TYPE as duplicate issue criteria
.Add(10, "") ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< col 10 (J) IT_Service as duplicate issue criteria
.Add(11, "") ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< col 11 (K) Business_Service as duplicate issue criteria
.Add(21, "") ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< col 21 (U) Affected_Staff_Id as duplicate issue criteria
End With
unique = vbNullString
'If CASE_SENSITIVE = 1 Then
' valDict.CompareMode = vbBinaryCompare
'Else
' valDict.CompareMode = vbTextCompare
'End If
' Flag Creation
searchRng = MainSheet1.Range(MainSheet1.Cells(FIRST_ROW, FIRST_COL), _
MainSheet1.Cells(InteractionRows, LAST_COL))
If LAST_COL < totalURCols Then
MainSheet1.Range(MainSheet1.Cells(FIRST_ROW, LAST_COL + 1), _
MainSheet1.Cells(FIRST_ROW, totalURCols)).EntireColumn.Delete() 'delete any extra columns
End If
memArr = searchRng.Resize(InteractionRows, LAST_COL + 1) 'entire range with data to mem
For i = 1 To InteractionRows 'each row, without the header
For j = 1 To LAST_COL 'each col
If includedColumns.ContainsKey(j) Then
unique = unique & searchRng(i, j) 'concatenate values on same row
End If
Next
If valDict.ContainsKey(unique) Then 'check if entire row exists
memArr(i, LAST_COL + 1) = dupe 'if it does, flag it in last col
Else
valDict.Add(unique, i) 'else add it to the dictionary
memArr(i, LAST_COL + 1) = "0"
End If
unique = vbNullString
Next
End Sub
这篇关于Visual Basic COMException错误的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！