Ошибка несоответствия в VBA - проблемы со столбцами - PullRequest
0 голосов
/ 02 ноября 2019

У меня есть рабочая тетрадь, в которой я хочу найти различия двух листов, взглянув на название компании и их корпоративный регистрационный номер, а затем введите различия на третьем листе.

Я пробовал код в другой книге только с 143 строками, что прекрасно работает, но когда я пробую его на реальной книге с 10000 строками, я получаю «ошибку несоответствия типов». Также, если я использую другие столбцы, кроме столбцов CVR и Firm, код также работает.

CVR - это числа, а Firms - это строки (названия фирм). Я получаю

ошибку несоответствия типов

в строке, которую я пометил **. Кто-нибудь знает, почему я получаю эту ошибку?

Sub ComCVR()
Dim CVR1()
Dim CVR2()
Dim Firm1()
Dim Firm2()
Dim n As Long, m As Long
Dim i As Double, j As Double
Dim intCurRow1 As Integer, intCurRow2 As Integer
Dim rng As Range, rng1 As Range

Set rng = ThisWorkbook.Sheets("Last month").Range("A11")
Set rng1 = ThisWorkbook.Sheets("Current month").Range("A11")

n = rng.CurrentRegion.Rows.Count
m = rng1.CurrentRegion.Rows.Count

ReDim CVR1(n)
ReDim Firm1(n)
ReDim CVR2(m)
ReDim Firm2(m)

ThisWorkbook.Sheets("CVR").Range("A1") = "Flyttet CVR"
ThisWorkbook.Sheets("CVR").Range("B1") = "Flyttet Firmanavn"
ThisWorkbook.Sheets("CVR").Range("A1:B1").Interior.ColorIndex = 3
ThisWorkbook.Sheets("CVR").Range("C1") = "Nye CVR"
ThisWorkbook.Sheets("CVR").Range("D1") = "Nye Firmanavn"
ThisWorkbook.Sheets("CVR").Range("C1:D1").Interior.ColorIndex = 4
ThisWorkbook.Sheets("CVR").Range("A1:D1").Font.Bold = True

' Inset data to arrays
For i = 0 To n
    CVR1(i) = ThisWorkbook.Sheets("Last month").Cells(12 + i, 5)
    Firm1(i) = ThisWorkbook.Sheets("Last month").Cells(12 + i, 4)
Next

For i = 0 To m
    CVR2(i) = ThisWorkbook.Sheets("Current month").Cells(12 + i, 5)
    Firm2(i) = ThisWorkbook.Sheets("Current month").Cells(12 + i, 4)
Next
intCurRow1 = 2
intCurRow2 = 2

'Old
For i = 0 To n
    For j = 0 To m
        If Firm1(i) = ThisWorkbook.Sheets("Current month").Cells(12 + j, 4) Then  '** Error raised here   
      Exit For
        End If

        If j = m Then
            ThisWorkbook.Sheets("CVR").Cells(intCurRow1, 1) = CVR1(i)
            ThisWorkbook.Sheets("CVR").Cells(intCurRow1, 2) = Firm1(i)
            intCurRow1 = intCurRow1 + 1
        End If
    Next j
Next i

'new
For i = 0 To m
    For j = 0 To n
        If Firm2(i) = ThisWorkbook.Sheets("Last month").Cells(12 + j, 4) Then
            Exit For
        End If

        If j = n Then
            ThisWorkbook.Sheets("CVR").Cells(intCurRow2, 3) = CVR2(i)
            ThisWorkbook.Sheets("CVR").Cells(intCurRow2, 4) = Firm2(i)
            intCurRow2 = intCurRow2 + 1
        End If
    Next j
Next i

Columns("A:B").Select
ActiveSheet.Range("$A:$B").RemoveDuplicates Columns:=1, Header:=xlNo
Application.DisplayAlerts = False

Columns("C:D").Select
ActiveSheet.Range("$C:$D").RemoveDuplicates Columns:=1, Header:=xlNo
Application.DisplayAlerts = False

End Sub

1 Ответ

0 голосов
/ 02 ноября 2019

Всякий раз, когда возникает ошибка, лучше всего ее погуглить. Это то, что сказано в документации VBA для несоответствия типов:

Причина: переменная или свойство имеет неправильный тип. Например, переменная, которая требует целочисленного значения, не может принимать строковое значение, если вся строка не может быть распознана как целое число.

В случае кода это происходит,когда массив сравнивается с ячейкой Excel. Теперь хитрость - чтобы понять, почему это происходит, посмотрите, что в них:

Debug.Print ThisWorkbook.Sheets("Last month").Cells(12 + i, 4)
Debug.Print Firm1(i)

и после того, как ошибка запускается, взгляните на ближайшее окно ( Ctrl + G ). Вполне возможно, что в ячейке Excel произошла ошибка, поэтому ее нельзя сравнивать. Это простой способ избежать этого, если это так:

Sub TestMe()

    Dim myRange As Range
    Set myRange = Worksheets(1).Cells(1, 1)

    myRange.Formula = "=0/0"
    If Not IsError(myRange) Then
        Debug.Print CBool(myRange = 2)
    Else
        Debug.Print myRange.Address; " is error!"
    End If

End Sub
...