Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Макрос сравнения/вставки. Признак сравнения - фраза первого - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос сравнения/вставки. Признак сравнения - фраза первого (Макросы/Sub)
Макрос сравнения/вставки. Признак сравнения - фраза первого
wwizard Дата: Понедельник, 20.09.2021, 09:41 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 174
Репутация: 0 ±
Замечаний: 40% ±

Очень нужна помощь форумчан:

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

Очень нужен макрос сравнения/вставки. Т.е. требуется чтобы со второго листа он взял всю строку, сравнив ее лишь по первой ячейке первого столбца, с первым листом/первым столбцом. При нахождении полного совпадения по слову - в первой ячейке первого столбца (учитываем только слово, то что есть после него - не важно, например после пробела что-то в скобках, или еще слова, т.е. первое слово найдено, во втором листе первого столбца, и оно такое же есть на первом листе в первом столбце), требуется раздвинуть и прямо под найденным таким же значением фразы в первом листе вставить всю строку со второго листа - желательно заменив цвет всей скопированной строки на зеленый. Если находит такую же вторую строку, раздвигает опять и вставляет ниже - на первом листе следующую позицию.

Попробовал сам - но чтото не хотит((
К сообщению приложен файл: Kondey1.xlsm(48.1 Kb)


Сообщение отредактировал Serge_007 - Понедельник, 20.09.2021, 12:16
 
Ответить
СообщениеОчень нужна помощь форумчан:

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

Очень нужен макрос сравнения/вставки. Т.е. требуется чтобы со второго листа он взял всю строку, сравнив ее лишь по первой ячейке первого столбца, с первым листом/первым столбцом. При нахождении полного совпадения по слову - в первой ячейке первого столбца (учитываем только слово, то что есть после него - не важно, например после пробела что-то в скобках, или еще слова, т.е. первое слово найдено, во втором листе первого столбца, и оно такое же есть на первом листе в первом столбце), требуется раздвинуть и прямо под найденным таким же значением фразы в первом листе вставить всю строку со второго листа - желательно заменив цвет всей скопированной строки на зеленый. Если находит такую же вторую строку, раздвигает опять и вставляет ниже - на первом листе следующую позицию.

Попробовал сам - но чтото не хотит((

Автор - wwizard
Дата добавления - 20.09.2021 в 09:41
doober Дата: Понедельник, 20.09.2021, 16:13 | Сообщение № 2
Группа: Друзья
Ранг: Ветеран
Сообщений: 816
Репутация: 301 ±
Замечаний: 0% ±

Excel 2010
Попробовал сам - но чтото не хотит
Жесть. :)




Сообщение отредактировал doober - Понедельник, 20.09.2021, 18:24
 
Ответить
Сообщение
Попробовал сам - но чтото не хотит
Жесть. :)

Автор - doober
Дата добавления - 20.09.2021 в 16:13
Erjoma1981 Дата: Понедельник, 20.09.2021, 17:00 | Сообщение № 3
Группа: Проверенные
Ранг: Участник
Сообщений: 66
Репутация: 23 ±
Замечаний: 0% ±

Excel 2010, 2019
[vba]
Код
Function НомерПоследнейСтроки(Страница As Worksheet) As LongPtr
    НомерПоследнейСтроки = Страница.UsedRange.Row + Страница.UsedRange.Rows.Count - 1
End Function

Sub ОбработкаДополнительныхТоваров()
    Dim ОбрабатываемаяЯчейка As Range, ПерваяЯчейка As Range, ПерваяЯчейкаПоиска As Range, НайденноеЗначение As Range
    Dim Идентификатор As String
    Dim ПозицияПробела As Byte
       
    Set ПерваяЯчейка = Sheets("Разное").Cells(2, 1)
    Set ПерваяЯчейкаПоиска = Sheets("Основной прайс").Cells(3, 1)
        
    For Each ОбрабатываемаяЯчейка In Sheets("Разное").Range(ПерваяЯчейка, Sheets("Разное").Cells(НомерПоследнейСтроки(Sheets("Разное")), 1))
        If Not IsEmpty(ОбрабатываемаяЯчейка.Offset(0, 1).Value) Then
            ПозицияПробела = InStr(ОбрабатываемаяЯчейка.Value, " ")
            If ПозицияПробела > 0 Then
                Идентификатор = Left(ОбрабатываемаяЯчейка.Value, ПозицияПробела - 1)
            Else
                Идентификатор = ОбрабатываемаяЯчейка.Value
            End If
            Set НайденноеЗначение = Sheets("Основной прайс").Range(ПерваяЯчейкаПоиска, Sheets("Основной прайс").Cells(НомерПоследнейСтроки(Sheets("Основной прайс")), 1)).Find(Идентификатор & "*", LookIn:=xlValues, LookAt:=xlWhole)
            If Not НайденноеЗначение Is Nothing Then
                Sheets("Основной прайс").Rows(НайденноеЗначение.Row + 1).Insert
                Sheets("Разное").Range(Sheets("Разное").Cells(ОбрабатываемаяЯчейка.Row, 1), Sheets("Разное").Cells(ОбрабатываемаяЯчейка.Row, 58)).Copy Sheets("Основной прайс").Cells(НайденноеЗначение.Row + 1, 1)
                Sheets("Основной прайс").Range(Sheets("Основной прайс").Cells(НайденноеЗначение.Row + 1, 1), Sheets("Основной прайс").Cells(НайденноеЗначение.Row + 1, 58)).Interior.Color = vbGreen
             End If
        End If
    Next ОбрабатываемаяЯчейка
End Sub
[/vba]
 
Ответить
Сообщение[vba]
Код
Function НомерПоследнейСтроки(Страница As Worksheet) As LongPtr
    НомерПоследнейСтроки = Страница.UsedRange.Row + Страница.UsedRange.Rows.Count - 1
End Function

Sub ОбработкаДополнительныхТоваров()
    Dim ОбрабатываемаяЯчейка As Range, ПерваяЯчейка As Range, ПерваяЯчейкаПоиска As Range, НайденноеЗначение As Range
    Dim Идентификатор As String
    Dim ПозицияПробела As Byte
       
    Set ПерваяЯчейка = Sheets("Разное").Cells(2, 1)
    Set ПерваяЯчейкаПоиска = Sheets("Основной прайс").Cells(3, 1)
        
    For Each ОбрабатываемаяЯчейка In Sheets("Разное").Range(ПерваяЯчейка, Sheets("Разное").Cells(НомерПоследнейСтроки(Sheets("Разное")), 1))
        If Not IsEmpty(ОбрабатываемаяЯчейка.Offset(0, 1).Value) Then
            ПозицияПробела = InStr(ОбрабатываемаяЯчейка.Value, " ")
            If ПозицияПробела > 0 Then
                Идентификатор = Left(ОбрабатываемаяЯчейка.Value, ПозицияПробела - 1)
            Else
                Идентификатор = ОбрабатываемаяЯчейка.Value
            End If
            Set НайденноеЗначение = Sheets("Основной прайс").Range(ПерваяЯчейкаПоиска, Sheets("Основной прайс").Cells(НомерПоследнейСтроки(Sheets("Основной прайс")), 1)).Find(Идентификатор & "*", LookIn:=xlValues, LookAt:=xlWhole)
            If Not НайденноеЗначение Is Nothing Then
                Sheets("Основной прайс").Rows(НайденноеЗначение.Row + 1).Insert
                Sheets("Разное").Range(Sheets("Разное").Cells(ОбрабатываемаяЯчейка.Row, 1), Sheets("Разное").Cells(ОбрабатываемаяЯчейка.Row, 58)).Copy Sheets("Основной прайс").Cells(НайденноеЗначение.Row + 1, 1)
                Sheets("Основной прайс").Range(Sheets("Основной прайс").Cells(НайденноеЗначение.Row + 1, 1), Sheets("Основной прайс").Cells(НайденноеЗначение.Row + 1, 58)).Interior.Color = vbGreen
             End If
        End If
    Next ОбрабатываемаяЯчейка
End Sub
[/vba]

Автор - Erjoma1981
Дата добавления - 20.09.2021 в 17:00
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос сравнения/вставки. Признак сравнения - фраза первого (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования Jobsora jooble
© 2010-2021 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!