Ошибка Visual Basic COMException

Question

Привет, У меня есть код VBA, который ищет дубликаты строк в excel на основе определенных столбцов для просмотра. Я пытаюсь преобразовать его в VB, однако я получаю ошибку: COMException было необработанное Исключение из HRESULT: 0x800A0005 (CTL_E_ILLEGALFUNCTIONCALL)

Я получаю это на линии «Если includedColumns.Exists (J) Тогда». Кодекс:

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 

Любая помощь будет принята с благодарностью.

Answer 1

Аналогичный подход с использованием Generic Словарь

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