Страницы: 1
RSS
Макрос сравнения/вставки. Признак сравнения - фраза первого столбеца обоих листов в книге.
 
Добрый всем вечер. Очень нужна помощь форумчан:

Наученный горьким опытом, постановок прошлых вопросов, попытаюсь объяснить что мне требуется. Есть большой прайс лист. Книга - состоящая из двух листов. На первом листе сам прайс, создаваемый вручную - с характеристиками каждого товара. Второй лист технический - куда скидываем все что находим по тем или иным товарам. Признак сравнения между ними - это первый столбец в каждом листе, всей книги. На втором листе - может быть много строк наименований товаров, но опять же признак сравнения - это фраза в первой ячейке первого столбца.

Очень нужен макрос сравнения/вставки. Т.е. требуется чтобы со второго листа он взял всю строку, сравнив ее лишь по первой ячейке первого столбца, с первым листом/первым столбцом. При нахождении полного совпадения по слову - в первой ячейке первого столбца (учитываем только слово, то что есть после него - не важно, например после пробела что-то в скобках, или еще слова, т.е. первое слово найдено, во втором листе первого столбца, и оно такое же есть на первом листе в первом столбце), требуется раздвинуть и прямо под найденным таким же значением фразы в первом листе вставить всю строку со второго листа - желательно заменив цвет всей скопированной строки на зеленый. Если находит такую же вторую строку, раздвигает опять и вставляет ниже - на первом листе следующую позицию.
Изменено: Михаил Иванченков - 19.09.2021 22:22:58
 
Цитата
Михаил Иванченков написал:
Признак сравнения - фраза первого столбеца
Цитата
Михаил Иванченков написал:
При нахождении полного совпадениb по первому слову
вот в данном случае одна фраза перечеркивает другую
решать задачу в которой не понятны условия - это мартышкин труд!
не волнуйтесь, подружите описание вашей задачи с логикой, кто-нибудь поймет и решит, если не обломится.... сначала угадать что же вы хотите сравнивать, а потом все решать в надежде, что угадано верно))
Изменено: Ігор Гончаренко - 19.09.2021 22:18:04
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
Ігор Гончаренко написал: подружите описание вашей задачи с логикой
Исправил, очень прошу помощи форумчан

Цитата
Ігор Гончаренко написал: что же вы хотите сравнивать
Попробовал написать сам - но он берет тогда построчно и нормально не хотит((
Код
Sub W3W()
'
' W3W Ìàêðîñ
'

'
    Range("A94").Select
    Selection.Copy
    Sheets("Temp price").Select
    Cells.Find(What:="CH-S07FTXW", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Sheets("PRICE FULL").Select
    Range("A95").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Temp price").Select
    Cells.Find(What:="CH-S09FTXW", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Sheets("PRICE FULL").Select
    ActiveWindow.SmallScroll Down:=12
    Range("A103").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Temp price").Select
    Cells.Find(What:="CH-S12FTXP-NG", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Rows("67:67").Select
    Application.CutCopyMode = False
    Selection.Cut
    Sheets("PRICE FULL").Select
    Rows("104:104").Select
    Selection.Insert Shift:=xlDown
    Range("A105").Select
    Selection.Copy
    Sheets("Temp price").Select
    Range("A82").Select
    Cells.Find(What:="CH-S18FTXP-NG", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Rows("99:99").Select
    Application.CutCopyMode = False
    Selection.Cut
    Sheets("PRICE FULL").Select
    Rows("106:106").Select
    Selection.Insert Shift:=xlDown
    ActiveWindow.SmallScroll Down:=6
    Range("A107").Select
    Selection.Copy
    Sheets("Temp price").Select
    Range("A105").Select
    Cells.Find(What:="CH-S24FTXP-NG", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Rows("121:121").Select
    Application.CutCopyMode = False
    Selection.Cut
    Sheets("PRICE FULL").Select
    Rows("108:108").Select
    Selection.Insert Shift:=xlDown
    Range("A110").Select
    Selection.Copy
    Sheets("Temp price").Select
    Range("A125").Select
    Cells.Find(What:="CH-S07FTXF-NG", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Rows("4:4").Select
    Application.CutCopyMode = False
    Selection.Cut
    Sheets("PRICE FULL").Select
    Rows("111:111").Select
    Selection.Insert Shift:=xlDown
    Range("A112").Select
    Selection.Copy
    Sheets("Temp price").Select
    Range("A28").Select
    Cells.Find(What:="CH-S09FTXF-NG", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Rows("24:24").Select
    Application.CutCopyMode = False
    Selection.Cut
    Sheets("PRICE FULL").Select
    Rows("113:113").Select
    Selection.Insert Shift:=xlDown
    Range("A114").Select
    Selection.Copy
    Sheets("Temp price").Select
    Range("A27").Select
    Cells.Find(What:="CH-S12FTXF-NG", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Rows("58:58").Select
    Application.CutCopyMode = False
    Selection.Cut
    Sheets("PRICE FULL").Select
    Rows("115:115").Select
    Selection.Insert Shift:=xlDown
    ActiveWindow.SmallScroll Down:=6
    Range("A116").Select
    Selection.Copy
    Sheets("Temp price").Select
    Selection.Find(What:="CH-S18FTXF-NG", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
    Range("R62").Select
    Cells.Find(What:="CH-S18FTXF-NG", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Sheets("PRICE FULL").Select
    Range("A117").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Temp price").Select
    Range("A62").Select
    Cells.Find(What:="CH-S24FTXF-NG", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Sheets("PRICE FULL").Select
    ActiveWindow.SmallScroll Down:=9
    Range("A119").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Temp price").Select
    Cells.Find(What:="CH-S09FTXÑ", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Sheets("PRICE FULL").Select
    Range("A120").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Temp price").Select
    Range("S62").Select
    Cells.Find(What:="CH-S12FTXÑ", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Sheets("PRICE FULL").Select
    Range("A121").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Temp price").Select
    Range("T63").Select
    Cells.Find(What:="CH-S18FTXÑ", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Range("A64").Select
    Sheets("PRICE FULL").Select
    Range("A122").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Temp price").Select
    Cells.Find(What:="CH-S24FTXÑ", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Sheets("PRICE FULL").Select
    Range("A124").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Temp price").Select
    Range("R66").Select
    Cells.Find(What:="CH-S07FTXE", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Rows("3:3").Select
    Application.CutCopyMode = False
    Selection.Cut
    Sheets("PRICE FULL").Select
    Rows("125:125").Select
    Selection.Insert Shift:=xlDown
    ActiveWindow.SmallScroll Down:=6
    Range("A126").Select
    Selection.Copy
    Sheets("Temp price").Select
    Range("A20").Select
    Cells.Find(What:="CH-S09FTXE-NG", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Rows("23:23").Select
    Application.CutCopyMode = False
    Selection.Cut
    Sheets("PRICE FULL").Select
    Rows("127:127").Select
    Selection.Insert Shift:=xlDown
    Range("A128").Select
    Selection.Copy
    Sheets("Temp price").Select
    Range("A20").Select
    Cells.Find(What:="CH-S12FTXE-NG", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Rows("57:57").Select
    Application.CutCopyMode = False
    Selection.Cut
    Sheets("PRICE FULL").Select
    Rows("129:129").Select
    Selection.Insert Shift:=xlDown
End Sub



Результат того что получилось - приложил.
Изменено: Михаил Иванченков - 20.09.2021 10:46:01
 
Михаил Иванченков, какой из столбцов на первом листе брать за основу, что это номенклатура (значение для номенклатуры всегда не пустое, в иных случаях пустое), а не что-то другое (например, раздел, подраздел)?

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
Код
Sub ПеренестиРазное()
    Dim y As Long
    Dim u As Long
    Dim v As Variant
    With Sheets("Разное")
        Dim arR As Variant
        Dim brr As Variant
        y = .Cells(.Rows.Count, 1).End(xlUp).Row
        arR = .Range(.Cells(1, 1), .Cells(y, 1 - (y = 1)))
        For y = 2 To UBound(arR, 1)
            If arR(y, 1) <> "" Then
                For Each v In Array("/", "(", Chr(160))
                    arR(y, 1) = Replace(arR(y, 1), v, " ")
                Next
                arR(y, 1) = Trim(arR(y, 1))
                brr = Split(arR(y, 1), " ")
                u = 0
                On Error Resume Next
                u = WorksheetFunction.Match(brr(0), Sheets("Основной прайс").Columns(1), 0)
                On Error GoTo 0
                If u > 0 Then
                    Sheets("Основной прайс").Rows(u + 1).Insert Shift:=xlDown
                    .Rows(y).Copy Sheets("Основной прайс").Cells(u + 1, 1)
                    Sheets("Основной прайс").Cells(u + 1, 1).EntireRow.Interior.Color = RGB(200, 255, 200)
                End If
            End If
        Next
    End With
End Sub
 
Код
Sub AddRows()
  Dim a, d, r&, r2&, c&
  Worksheets(1).Activate
  Set d = CreateObject("Scripting.Dictionary")
  With Worksheets(2)
    a = Range(.Cells(1), .Cells(.Rows.Count, 1).End(xlUp))
    For r = 1 To UBound(a)
      If Not IsEmpty(a(r, 1)) Then d(Split(a(r, 1))(0)) = r
    Next
    a = Range(Cells(1), Cells(Rows.Count, 1).End(xlUp))
    For r = UBound(a) To 1 Step -1
      If Not IsEmpty(a(r, 1)) Then
        If d.exists(Split(a(r, 1))(0)) Then
          Rows(r + 1).Insert: r2 = d(Split(a(r, 1))(0)): c = c + 1
          .Rows(r2).Copy Cells(r + 1, 1): Rows(r + 1).Interior.Color = RGB(0, 255, 0)
        End If
      End If
    Next
  End With
  MsgBox "Вставлено " & c & " строк", , "Готово!"
End Sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
МатросНаЗебре, ругается на: Subscript out of range

Ігор Гончаренко, все так.
Только во второй лист вставлять не нужно)) - Он должен найти повтор с первым листом - первого столбца - и под ним, под повтором - вставить всю строку со второго листа.
Изменено: vikttur - 21.09.2021 00:47:13
 
Цитата
Михаил Иванченков написал:
Ругается на: Subscript out of range
может в активной книге просто нет листа "Разное"? Вы проверили?
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Нет((  - После проверки  - все заработало. Спасибо.
Изменено: Михаил Иванченков - 20.09.2021 23:14:07
 
Цитата
Михаил Иванченков написал:
Только во второй лист вставлять не нужно
ничего не вставляет на второй лист
но повторный запуск макроса понавставляет строк к уже вставленным
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
вариант... результат в копии листа Основной прайс на всякий...

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
МатросНаЗебре Можно попросить глянуть, тот макрос (в списке он называется "ЕЕ"), что Вы мне предложили, и который очень классно работает. Только я не могу понять почему он НЕ обрабатывает все позиции со второго листа первой колонки. Какие-то берет для сравнения и вывода на первый лист, а какие-то просто проходит мимо((. Хотя я проверил - они полностью идентичны, но скрипт почему то не захотел их обрабатывать.
Изменено: Михаил Иванченков - 22.09.2021 19:40:15
Страницы: 1
Наверх