макрос для сверки значений в двух столбцах

[Olya1985]

Помогите, пожалуйста исправить макрос так, чтобы ускорился процесс сверки значений из 2-ух столбцов. Макрос во вложении. Если в файле 5000 строк, то сейчас он работает очень долго.

[SAS888]

Существенно быстрее будет так:

Sub check()
    Dim i As Long, x As Range, a(), b(), c(), d(), ws1 As Worksheet, ws2 As Worksheet
    Application.ScreenUpdating = False: Set ws1 = Sheets("Data"): Set ws2 = Sheets("Report")
    a = ws1.Range("B2:B" & ws1.Cells(Rows.Count, 2).End(xlUp).Row).Value
    b = ws1.Range("V2:V" & ws1.Cells(Rows.Count, 2).End(xlUp).Row).Value
    ReDim c(1 To UBound(a, 1), 1 To 1): ReDim d(1 To UBound(a, 1), 1 To 1)
    For i = 1 To UBound(a, 1)
        Set x = ws2.[A:A].Find(what:=a(i, 1), LookAt:=xlWhole)
        If Not x Is Nothing Then c(i, 1) = x.Offset(, 17)
        If b(i, 1) = c(i, 1) Then d(i, 1) = "TRUE" Else d(i, 1) = "FALSE"
    Next
    ws1.[W2].Resize(UBound(c, 1)).Value = c
    ws1.[X2].Resize(UBound(d, 1)).Value = d
End Sub

Пример во вложении.

[Olya1985]

Спасибо!

еще одна небольшая проблемка возникла.

в строке 7 значения а = а, но почему то пишет false

[IgorGO]

видите ли
а "а" не равно a "эй"
так же как и
с "эс" не равно c "си"

[Olya1985]

теперь ясно в чем тут дело. спасибо!

[Olya1985]

подскажите, пожалуйста, а можно ли изменить скрипт таким образом, чтобы не делалось различий между а (эй) и русской а?

[kuklp]

Легче(и правильней) поменять буквы на правильные. Выделяем диапазон и:

Sub ChangeEngRus_CcEeTOopPAaHKkXxBM()
    Dim c As Object
    Dim n As Integer, i As Integer, posChar As Integer
    Dim ToRusLang As Boolean
    Dim LineChars(1) As String * 72
    Dim Ch As String * 1
    Dim TempSelection As String
    LineChars(0) = "CcEeTOopPAaHKkXxBM"
    LineChars(1) = "СсЕеТОорРАаНКкХхВМ"
    For Each c In Selection.Cells
        TempSelection = c.Value
        ToRusLang = True
        For i = 1 To Len(TempSelection)
            Ch = Mid(TempSelection, i, 1)
            n = ToRusLang + 1
            posChar = InStr(LineChars(n), Ch)
            If posChar = 0 Then
                n = 0    'Abs(n - 1)
                posChar = InStr(LineChars(n), Ch)
            End If
            If posChar <> 0 Then
                Select Case n
                Case 0
                    ToRusLang = True
                Case 1
                    ToRusLang = False
                End Select
                Mid(TempSelection, i, 1) = Mid(LineChars(Abs(n - 1)), posChar, 1)
            End If
        Next
        c.Value = TempSelection
    Next c
    'Color_RUS_LAT
End Sub

[Olya1985]

спасибо! а как он работает?

[kuklp]

Он меняет все латинские(похожие на кириллические) буквы на русские.