Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Возможно ли усовершенствовать макрос выравнивающий (сортирующий) совпадения в двух столбцах
 
#1
16.11.2021 20:04:12
Здравствуйте. Я нашёл в сети макрос который как я понял способен расположить соосносто найденные совпадения в двух столбцах на одном листе.
Вопрос судя по коду он написан под совпадения которые начинаются с Букв, а можно ли изменить это на цифры.

Я столбец Z1:Z100 (примет тренировочный) сравниваю с помощью формулы массива =ЕСЛИ(ЕНД(ПОИСКПОЗ(ИСТИНА;СОВПАД($AM$2:$AM$100;Z2);0));"нет";"есть") (столбец AL) со столбцом AM1:AM100. Машина находит совпадения, только самих номеров из столбцов Z и AM, номера в обоих столбцах располагаются не по порядку, правее них есть AN по AU. Вопрос можно ли заставить макрос (или сделать это с помощью формулы) что бы если номер из столбца Z1:Z100 совпадает с номером из столбца AM1:AM100, то машина напротив (правее) совпавшего номера из столбца Z1:Z100 выводила бы совпавший номер из столбца AM1:AM100 и данные из столбцов AN по AU в том числе и пустые.
Может быть нужно располагать данные на разных листах или наоборот чтоб машина "сшивала" данные на новом листе, или вообзе это можно хитро сделать с помощью ВПР.
Прошу вашего совета, пример прилагаю.
Код найденного макроса
Код
?
1
2
3
4
5
6
7
8
9
10
11
Sub Listduplicates()
'Updateby Extendoffice 20160613
    Dim rngA As Range
    Set rngA = Range([E1], Cells(Rows.Count, "E").End(xlUp))
    rngA.Offset(0, 1).Columns.Insert
    With rngA.Offset(0, 1)
        .FormulaR1C1 = _
        "=IF(ISNA(MATCH(RC[-1],C[1],0)),"""",INDEX(C[1],MATCH(RC[-1],C[1],0)))"
        .Value = .Value
    End With
End Sub
 
 
 
#2
16.11.2021 20:26:24
из вашего рассказа понятно
есть столбцы с данными Z и AM
а какого результата вы добиваетесь? что нужно получить в итоге?
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#3
16.11.2021 20:44:48
Цитата
написал:
из вашего рассказа понятноесть столбцы с данными Z и AMа какого результата вы добиваетесь? что нужно получить в итоге?
Результат такой. Столбцы Z и AM нужно сравнить между собой. Если есть совпадения вывести на экран совпавшие номера, правее совпавших номеров вывести данные из столбцов с AN по AU. Как будто функция ЛЕВСИМ всё что начиная со столбца A до Z вывела на левую часть таблицы, а условно функция ПРАВСИМ вывела все данные со столбца  AM до AU, условно конечно. Главная проблема в том что, я могу найти совпадения в номерах Z и AM, в том числе и совпавшие номера, но нужно расположить их соостно - как пример № _12108880002000188 находиться в ячейке Z6, а его пара такой же номер _12108880002000188 в ячейке АМ9, нужно сделать так что бы напротив ячейки Z6 встала пара её пара из ячейки АМ9 и данные из ячейке с AN9 по AU9, то есть машина бы совместила (отсортировала, расположила соостно) на это же листе, или на листе 2, то есть то что до столбца Z машина не трогает, Z и АМ сравнивает на точное совпадение, и располагает данные с АМ по AU в порядке совпадения.  
 
 
 
#4
16.11.2021 20:48:41
zvolkz,  ну вот зачем в данном случае цитата? Да и не цитата это, а полная копия сообщения Игоря.
Цитируйте только при необходимости и только то, на чём хотите сделать акцент.
 
 
 
#5
16.11.2021 20:49:54
Вас понял,учту.
 
 
 
#6
16.11.2021 21:02:41
см. файл. если что - допилите под себя. Сейчас вывел результат в столбец AW, если выводить в столбцы AM:AU, то результат макроса сотрёт старые данные в этих столбцах
Изменено: New - 16.11.2021 21:03:42
 
 
 
#7
16.11.2021 21:29:21
Код
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub FindAMinZ()
  Dim a, b, d, r&
  a = [z1].CurrentRegion: Set d = CreateObject("Scripting.Dictionary")
  For r = 2 To UBound(a)
    d(a(r, 1)) = r
  Next
  a = Range([am1], Cells(Rows.Count, 39)):
  ReDim b(1 To UBound(a), 1 To 1): b(1, 1) = "найдено в AM в строке"
  For r = 2 To UBound(a)
    If d.Exists(a(r, 1)) Then
      b(d(a(r, 1)), 1) = r
    End If
  Next
  [aa1].Resize(UBound(a), 1) = b
End Sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#8
17.11.2021 07:34:55
Большое спасибо за помощь New и Ігор Гончаренко.
New Ваш макрос замечательно работает, возник вопрос - если в столбцах с AM:AU кроме цифр появятся буквы с цифрами, например  1033-из, или 1032, втч, то есть сочетание цифр и текста. Можно ли в вашем коде поменять тип данных или код будет работать только с числовыми значениями в столбцах с AM:AU?
 
 
 
#9
17.11.2021 07:38:29
данному коду без разницы, что в ваших ячейках - числа, буквы, пустые
 
 
 
#10
17.11.2021 07:58:56
New ещё вопрос, может быть глупый, - если столбец Z короче чем столбец AM, например Z2:Z3000, а AM2:AM65000, макрос будет всё считать, или лучше столбец Z продлить выдуманными данными?
10-15 мин нормальное время расчёта задачи с Z2:Z65000, по AM2:AM65000 или макрос завис?
 
 
 
#11
17.11.2021 08:14:33
Цитата
zvolkz написал:
или лучше столбец Z продлить выдуманными данными?
Да, на 65000 может работать долго... не знаю сколько, надо тестировать
Вот так не нужно будет продлевать Z, макрос сам будет находить последнюю строку в столбце AM
Лучше не продлевайте Z ненужными данными, иначе это увеличит работу макроса. А используйте этот код
Код
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub Test()
    Dim arrNoNCD, arrData, arrOut, LastRow As Long, iRow As Long, i As Long, iCol As Long
     
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "Z").End(xlUp).Row
        arrNoNCD = .Range("Z2:Z" & LastRow).Value
        LastRow = .Cells(.Rows.Count, "AM").End(xlUp).Row
        arrData = .Range("AM2:AU" & LastRow).Value
    End With
     
    ReDim arrOut(1 To UBound(arrData), 1 To UBound(arrData, 2))
    For iRow = 1 To UBound(arrNoNCD)
        For i = 1 To UBound(arrData)
            If arrData(i, 1) = arrNoNCD(iRow, 1) Then
                For iCol = 1 To UBound(arrData, 2)
                    arrOut(iRow, iCol) = arrData(i, iCol)
                Next iCol
            End If
        Next i
    Next iRow
     
    Range("AW2").Resize(UBound(arrOut, 1), UBound(arrOut, 2)).Value = arrOut
    MsgBox "Данные выведены в столбец AW", vbInformation, "Конец"
End Sub
Изменено: New - 17.11.2021 08:17:43
 
 
 
#12
17.11.2021 08:52:27
17.11.2021 08:14:33 #11

Спасибо большое всё работает. Вы были правы без продления ненужными данными столбца Z всё посчиталось намного быстрее. Благодарен за помощь.
.
Изменено: zvolkz - 17.11.2021 08:54:33
 
 
 
#13
17.11.2021 13:54:40
New, я Решил попробовать изменить столбцы участвующие в сравнении вот  - Z на G, AM на AD, и вывод данных в столбец ВА, но макрос не сработал и выдал ошибку run time error 9 subscript out of range. Вопрос где я ошибся? Может быть диапазон AD2:AY слишком большой для обработки и максимум машина может обработать 9 столбцов с AM2:AU?

Код
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Test()    Dim arrNoNCD, arrData, arrOut, LastRow As Long, iRow As Long, i As Long, iCol As Long
      
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "G").End(xlUp).Row
        arrNoNCD = .Range("G2:G" & LastRow).Value
        LastRow = .Cells(.Rows.Count, "AD").End(xlUp).Row
        arrData = .Range("AD2:AY" & LastRow).Value
    End With
      
    ReDim arrOut(1 To UBound(arrData), 1 To UBound(arrData, 2))
    For iRow = 1 To UBound(arrNoNCD)
        For i = 1 To UBound(arrData)
            If arrData(i, 1) = arrNoNCD(iRow, 1) Then
                For iCol = 1 To UBound(arrData, 2)
                    arrOut(iRow, iCol) = arrData(i, iCol)
                Next iCol
            End If
        Next i
    Next iRow
      
    Range("BA2").Resize(UBound(arrOut, 1), UBound(arrOut, 2)).Value = arrOut
    MsgBox "Данные выведены в столбец BA", vbInformation, "Конец"
End Sub
 
 
 
#14
17.11.2021 14:36:51
у меня в вашем файле работает, вот потестируйте
Изменено: New - 17.11.2021 14:37:07
 
 
 
#15
17.11.2021 14:58:22
17.11.2021 14:36:51 #14
New, я понял почему у меня не выходило и макрос выдавал ошибку - опять дело в разной длине столбцов столбец G длиннее AD на 2500 строк, я это видел, но не придал значение. После добавления выдуманных данных в столбец AD, макрос нормально завершил свою работу и вывел совпавшие данные правее таблицы.
Вопрос - возможно ли сделать так же как Вы сделали когда столбец Z был короче чем столбец АМ в сообщении #11 ?
 
 
 
#16
17.11.2021 15:28:49
Код
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub Test()
    Dim arrNoNCD, arrData, arrOut, LastRow As Long, iRow As Long, i As Long, iCol As Long
       
    With ActiveSheet
        If .FilterMode Then .ShowAllData
        LastRow = .Cells(.Rows.Count, "G").End(xlUp).Row
        arrNoNCD = .Range("G2:G" & LastRow).Value
        LastRow = .Cells(.Rows.Count, "AD").End(xlUp).Row
        arrData = .Range("AD2:AY" & LastRow).Value
    End With
       
    ReDim arrOut(1 To UBound(arrNoNCD), 1 To UBound(arrData, 2))
    For iRow = 1 To UBound(arrNoNCD)
        For i = 1 To UBound(arrData)
            If arrData(i, 1) = arrNoNCD(iRow, 1) Then
                For iCol = 1 To UBound(arrData, 2)
                    arrOut(iRow, iCol) = arrData(i, iCol)
                Next iCol
            End If
        Next i
    Next iRow
       
    Range("BA2").Resize(UBound(arrOut, 1), UBound(arrOut, 2)).Value = arrOut
    MsgBox "Данные выведены в столбец BA", vbInformation, "Конец"
End Sub
 
 
 
#17
17.11.2021 15:44:05
17.11.2021 15:28:49 #16

New Вы создали замечательный макрос, работающий в обе стороны (сравниваемые столбцы могут быть меньше друг-друга), с возможностью масштабируемости, Огромное Вам за это спасибо.
Изменено: zvolkz - 17.11.2021 15:44:27
 
 
 
Страницы: 1
Читают тему
Loading...