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

Вход

Регистрация

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

 

= Мир MS Excel/при сверка и копирование ячеек - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » при сверка и копирование ячеек (Макросы/Sub)
при сверка и копирование ячеек
Ant645 Дата: Понедельник, 24.02.2020, 12:54 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2019
Здравствуйте!
Нужна Ваша помощь. Есть макрос который сравнивает столбца по порядку и копирует определенные ячейки (но копирование происходит не так как нужно, в файле указал как нужно). Он почему-то смещает результат. Например 2 -22- 222, 133 но он почему то 133 ставит для 4-21- И количество цифр может быть разное. Как сделать что бы копирование для определенного схожего числа оставалось в нужном диапазоне.

[vba]
Код


Sub Пробник_3()

Dim lLastRowA As Long
Dim lLastRowC As Long
Dim lLastRowB As Long
Dim i As Long
Dim rFind As Excel.Range

lLastRowA = Cells(Rows.Count, "F").End(xlUp).Row

lLastRowC = Cells(Rows.Count, "L").End(xlUp).Row + 1
lLastRowC = Cells(Rows.Count, "M").End(xlUp).Row + 1
lLastRowC = Cells(Rows.Count, "N").End(xlUp).Row + 1

Application.ScreenUpdating = False

For i = 2 To lLastRowA Step 1

Set rFind = Columns("K").Find(What:=Cells(i, "F").Text, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

If Not rFind Is Nothing Then
Cells(lLastRowC, "L").Value = Cells(i, "F").Value

lLastRowC = lLastRowC + 1

End If

Set rFind = Columns("L").Find(What:=Cells(i, "F").Text, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

If Not rFind Is Nothing Then
Cells(lLastRowC, "M").Value = Cells(i, "H").Value

lLastRowC = lLastRowC + 1
End If

Set rFind = Columns("M").Find(What:=Cells(i, "A").Text, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

If Not rFind Is Nothing Then
Cells(lLastRowC, "N").Value = Cells(i, "C").Value

lLastRowC = lLastRowC + 1

End If
Next i

Application.ScreenUpdating = True

End Sub
[/vba]
К сообщению приложен файл: 7580238.xlsm (20.0 Kb)


Сообщение отредактировал Ant645 - Понедельник, 24.02.2020, 13:38
 
Ответить
СообщениеЗдравствуйте!
Нужна Ваша помощь. Есть макрос который сравнивает столбца по порядку и копирует определенные ячейки (но копирование происходит не так как нужно, в файле указал как нужно). Он почему-то смещает результат. Например 2 -22- 222, 133 но он почему то 133 ставит для 4-21- И количество цифр может быть разное. Как сделать что бы копирование для определенного схожего числа оставалось в нужном диапазоне.

[vba]
Код


Sub Пробник_3()

Dim lLastRowA As Long
Dim lLastRowC As Long
Dim lLastRowB As Long
Dim i As Long
Dim rFind As Excel.Range

lLastRowA = Cells(Rows.Count, "F").End(xlUp).Row

lLastRowC = Cells(Rows.Count, "L").End(xlUp).Row + 1
lLastRowC = Cells(Rows.Count, "M").End(xlUp).Row + 1
lLastRowC = Cells(Rows.Count, "N").End(xlUp).Row + 1

Application.ScreenUpdating = False

For i = 2 To lLastRowA Step 1

Set rFind = Columns("K").Find(What:=Cells(i, "F").Text, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

If Not rFind Is Nothing Then
Cells(lLastRowC, "L").Value = Cells(i, "F").Value

lLastRowC = lLastRowC + 1

End If

Set rFind = Columns("L").Find(What:=Cells(i, "F").Text, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

If Not rFind Is Nothing Then
Cells(lLastRowC, "M").Value = Cells(i, "H").Value

lLastRowC = lLastRowC + 1
End If

Set rFind = Columns("M").Find(What:=Cells(i, "A").Text, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

If Not rFind Is Nothing Then
Cells(lLastRowC, "N").Value = Cells(i, "C").Value

lLastRowC = lLastRowC + 1

End If
Next i

Application.ScreenUpdating = True

End Sub
[/vba]
Автор - Ant645
Дата добавления - 24.02.2020 в 12:54
Kuzmich Дата: Понедельник, 24.02.2020, 13:45 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 711
Репутация: 156 ±
Замечаний: 0% ±

Excel 2003
Какой-то ребус-кроссворд
Цитата
'Определяем, где заканчиваются данные в столбце A,
'чтобы знать, до какой строки нам работать.

[vba]
Код
lLastRowA = Cells(Rows.Count, "F").End(xlUp).Row
[/vba]
При этом определяется последняя ячейка по столбцу F
Цитата
'Ищем в столбце B

[vba]
Код
Set rFind = Columns("K").Find(What:=Cells(i, "F").Text, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
[/vba]
При этом в коде поиск по столбцу К
Ну и т.д. Напишите по-русски, что вы хотите сравнивать и копировать.
 
Ответить
СообщениеКакой-то ребус-кроссворд
Цитата
'Определяем, где заканчиваются данные в столбце A,
'чтобы знать, до какой строки нам работать.

[vba]
Код
lLastRowA = Cells(Rows.Count, "F").End(xlUp).Row
[/vba]
При этом определяется последняя ячейка по столбцу F
Цитата
'Ищем в столбце B

[vba]
Код
Set rFind = Columns("K").Find(What:=Cells(i, "F").Text, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
[/vba]
При этом в коде поиск по столбцу К
Ну и т.д. Напишите по-русски, что вы хотите сравнивать и копировать.
Автор - Kuzmich
Дата добавления - 24.02.2020 в 13:45
Ant645 Дата: Понедельник, 24.02.2020, 14:04 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2019
Мне нужно что бы на выходе была таблица которая показывает какое значение куда входит, пример в файле есть, данный макрос вроде сравнивает но вставляет скопированные результаты не правильно) У меня идет сравнение столбца К с F (выдает результат сколько 2 и 4 есть, результат в L), потом результат из L сравниваю с таблицей F (дабы узнать куда они входят, происходит копирования из столбца H - куда входит значение из столбца F), потом результат из H сравниваю со столбцом A (происходит сравнение и копирование куда входит в столбец N из столбца С). Нужно что бы выстраивалась цепочка от 1 значения K до последнего значения куда входит С). Но вхождение может и не в одно число, а в несколько.
 
Ответить
СообщениеМне нужно что бы на выходе была таблица которая показывает какое значение куда входит, пример в файле есть, данный макрос вроде сравнивает но вставляет скопированные результаты не правильно) У меня идет сравнение столбца К с F (выдает результат сколько 2 и 4 есть, результат в L), потом результат из L сравниваю с таблицей F (дабы узнать куда они входят, происходит копирования из столбца H - куда входит значение из столбца F), потом результат из H сравниваю со столбцом A (происходит сравнение и копирование куда входит в столбец N из столбца С). Нужно что бы выстраивалась цепочка от 1 значения K до последнего значения куда входит С). Но вхождение может и не в одно число, а в несколько.
Автор - Ant645
Дата добавления - 24.02.2020 в 14:04
Kuzmich Дата: Понедельник, 24.02.2020, 14:10 | Сообщение № 4
Группа: Проверенные
Ранг: Ветеран
Сообщений: 711
Репутация: 156 ±
Замечаний: 0% ±

Excel 2003
Вот это, что такое
Цитата
'Определяем, с какой строки заносить данные в столбец C.

[vba]
Код
  lLastRowC = Cells(Rows.Count, "L").End(xlUp).Row + 1
    lLastRowC = Cells(Rows.Count, "M").End(xlUp).Row + 1
    lLastRowC = Cells(Rows.Count, "N").End(xlUp).Row + 1
[/vba]
В переменной lLastRowC будет только последняя пустая ячейка по столбцу N
 
Ответить
СообщениеВот это, что такое
Цитата
'Определяем, с какой строки заносить данные в столбец C.

[vba]
Код
  lLastRowC = Cells(Rows.Count, "L").End(xlUp).Row + 1
    lLastRowC = Cells(Rows.Count, "M").End(xlUp).Row + 1
    lLastRowC = Cells(Rows.Count, "N").End(xlUp).Row + 1
[/vba]
В переменной lLastRowC будет только последняя пустая ячейка по столбцу N
Автор - Kuzmich
Дата добавления - 24.02.2020 в 14:10
Ant645 Дата: Понедельник, 24.02.2020, 14:14 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2019
Kuzmich, А ну тут может что то не нужно, просто я плохо разбираюсь в VBA я всякое вставлял (скорее всего последние 2 удалить нужно) и Dim lLastRowB As Long тоже удалить. Они не повлияют на результат
 
Ответить
СообщениеKuzmich, А ну тут может что то не нужно, просто я плохо разбираюсь в VBA я всякое вставлял (скорее всего последние 2 удалить нужно) и Dim lLastRowB As Long тоже удалить. Они не повлияют на результат
Автор - Ant645
Дата добавления - 24.02.2020 в 14:14
Kuzmich Дата: Понедельник, 24.02.2020, 16:42 | Сообщение № 6
Группа: Проверенные
Ранг: Ветеран
Сообщений: 711
Репутация: 156 ±
Замечаний: 0% ±

Excel 2003
Как понял, проверяйте
[vba]
Код
Sub Пробник_4()
Dim lLastRowK As Long
Dim lLastRowL As Long
Dim lLastRowM As Long
Dim rFind_F As Range
Dim rFind_A As Range
Dim i As Long
Dim FAdr_F As String
Dim FAdr_A As String
     'выдает результат сколько 2 и 4 есть в столбце F, результат в L
  lLastRowK = Cells(Rows.Count, "K").End(xlUp).Row
  lLastRowL = 2
    Range("L2:N1000").ClearContents
  For i = 2 To lLastRowK   'цикл по значениям столбца К
     'ищем в столбце F значения столбца К
    Set rFind_F = Columns("F").Find(Cells(i, "K"), , xlValues, xlWhole)
    If Not rFind_F Is Nothing Then 'нашли первое вхождение
      FAdr_F = rFind_F.Address       'адрес первого вхождения
      Do
        Cells(lLastRowL, "L") = rFind_F
          lLastRowL = lLastRowL + 1
        Cells(lLastRowL, "M") = rFind_F.Offset(, 2)
          lLastRowL = lLastRowL + 1
        'ищем в столбце А (обозначение 2) значение из столбца Н (куда входит 1)
         Set rFind_A = Columns("A").Find(rFind_F.Offset(, 2), , xlValues, xlWhole)
         If Not rFind_A Is Nothing Then 'нашли первое вхождение
            FAdr_A = rFind_A.Address       'адрес первого вхождения
            Do
             Cells(lLastRowL, "N") = rFind_A.Offset(, 2)
             Set rFind_A = Columns("A").FindNext(rFind_A)
             lLastRowL = lLastRowL + 1
            Loop While rFind_A.Address <> FAdr_A
         End If
        Set rFind_F = Columns("F").Find(Cells(i, "K"), After:=rFind_F)
          lLastRowL = lLastRowL + 1
      Loop While rFind_F.Address <> FAdr_F
    End If
   lLastRowL = Cells(Rows.Count, "N").End(xlUp).Row + 2
  Next
End Sub
[/vba]
 
Ответить
СообщениеКак понял, проверяйте
[vba]
Код
Sub Пробник_4()
Dim lLastRowK As Long
Dim lLastRowL As Long
Dim lLastRowM As Long
Dim rFind_F As Range
Dim rFind_A As Range
Dim i As Long
Dim FAdr_F As String
Dim FAdr_A As String
     'выдает результат сколько 2 и 4 есть в столбце F, результат в L
  lLastRowK = Cells(Rows.Count, "K").End(xlUp).Row
  lLastRowL = 2
    Range("L2:N1000").ClearContents
  For i = 2 To lLastRowK   'цикл по значениям столбца К
     'ищем в столбце F значения столбца К
    Set rFind_F = Columns("F").Find(Cells(i, "K"), , xlValues, xlWhole)
    If Not rFind_F Is Nothing Then 'нашли первое вхождение
      FAdr_F = rFind_F.Address       'адрес первого вхождения
      Do
        Cells(lLastRowL, "L") = rFind_F
          lLastRowL = lLastRowL + 1
        Cells(lLastRowL, "M") = rFind_F.Offset(, 2)
          lLastRowL = lLastRowL + 1
        'ищем в столбце А (обозначение 2) значение из столбца Н (куда входит 1)
         Set rFind_A = Columns("A").Find(rFind_F.Offset(, 2), , xlValues, xlWhole)
         If Not rFind_A Is Nothing Then 'нашли первое вхождение
            FAdr_A = rFind_A.Address       'адрес первого вхождения
            Do
             Cells(lLastRowL, "N") = rFind_A.Offset(, 2)
             Set rFind_A = Columns("A").FindNext(rFind_A)
             lLastRowL = lLastRowL + 1
            Loop While rFind_A.Address <> FAdr_A
         End If
        Set rFind_F = Columns("F").Find(Cells(i, "K"), After:=rFind_F)
          lLastRowL = lLastRowL + 1
      Loop While rFind_F.Address <> FAdr_F
    End If
   lLastRowL = Cells(Rows.Count, "N").End(xlUp).Row + 2
  Next
End Sub
[/vba]
Автор - Kuzmich
Дата добавления - 24.02.2020 в 16:42
Ant645 Дата: Понедельник, 24.02.2020, 17:48 | Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2019
Kuzmich, Можете еще подсказать, какую нужно повторить команду если добавятся с лево еще таблица где указано куда входит столбец С (по принципу как для столбца H вхождение в первой таблице). Этот макрос работает круто спасибо большое.
 
Ответить
СообщениеKuzmich, Можете еще подсказать, какую нужно повторить команду если добавятся с лево еще таблица где указано куда входит столбец С (по принципу как для столбца H вхождение в первой таблице). Этот макрос работает круто спасибо большое.
Автор - Ant645
Дата добавления - 24.02.2020 в 17:48
Мир MS Excel » Вопросы и решения » Вопросы по VBA » при сверка и копирование ячеек (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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