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

Вход

Регистрация

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

 

= Мир MS Excel/перенос данных с одного листа на другой в другие ячейки - Мир MS Excel

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

Excel 2003
Всем здравствуйте, подскажите, пожалуйста, как сделать так, чтобы макросом производился поиск позиций с первого листа в столбце А и если совпадающие позиции есть на листе2 рядом с ними подставлялись значения с соседней ячейки.
Например, если на листе1 есть позиция Картофель, который равен 73 и на листе 2 в столбце B или D есть такая позиция, то рядом с ней подставлялось значение 73
К сообщению приложен файл: 2334938.xls (31.5 Kb)


Сообщение отредактировал benza89 - Понедельник, 18.02.2019, 14:53
 
Ответить
СообщениеВсем здравствуйте, подскажите, пожалуйста, как сделать так, чтобы макросом производился поиск позиций с первого листа в столбце А и если совпадающие позиции есть на листе2 рядом с ними подставлялись значения с соседней ячейки.
Например, если на листе1 есть позиция Картофель, который равен 73 и на листе 2 в столбце B или D есть такая позиция, то рядом с ней подставлялось значение 73

Автор - benza89
Дата добавления - 18.02.2019 в 14:52
krosav4ig Дата: Понедельник, 18.02.2019, 15:46 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 2346
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
здравствуйте
[vba]
Код
Sub d()
    Dim arr() As Variant
    Dim r As Range
    Set r = Parent.Sheets("Лист1").UsedRange
    With Me.UsedRange.Columns("B:E")
        arr = .Value
        For i = 1 To UBound(arr)
            For j = 2 To UBound(arr, 2) Step 2
                With Application
                    arr(i, j) = .IfError(.VLookup(arr(i, j - 1), r, 3, 0), "")
                End With
            Next
        Next
        .Value = arr
    End With
End Sub
[/vba]
до кучи в обратную сторону
[vba]
Код
Sub d()
    Dim arr() As Variant
    Dim rng As Range
    Set rng = Parent.Sheets("Лист2").UsedRange
    With Me.UsedRange.Columns("A:C")
        arr = .Value
        For i = 1 To UBound(arr)
            Set r = rng.Find(arr(i, 1), , xlValues, xlWhole, , , False, , False)
            If Not r Is Nothing Then arr(i, 3) = r.Offset(, 1).Value
        Next
        .Value = arr
    End With
End Sub
[/vba]

3342527.xls


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Понедельник, 18.02.2019, 17:18
 
Ответить
Сообщениездравствуйте
[vba]
Код
Sub d()
    Dim arr() As Variant
    Dim r As Range
    Set r = Parent.Sheets("Лист1").UsedRange
    With Me.UsedRange.Columns("B:E")
        arr = .Value
        For i = 1 To UBound(arr)
            For j = 2 To UBound(arr, 2) Step 2
                With Application
                    arr(i, j) = .IfError(.VLookup(arr(i, j - 1), r, 3, 0), "")
                End With
            Next
        Next
        .Value = arr
    End With
End Sub
[/vba]
до кучи в обратную сторону
[vba]
Код
Sub d()
    Dim arr() As Variant
    Dim rng As Range
    Set rng = Parent.Sheets("Лист2").UsedRange
    With Me.UsedRange.Columns("A:C")
        arr = .Value
        For i = 1 To UBound(arr)
            Set r = rng.Find(arr(i, 1), , xlValues, xlWhole, , , False, , False)
            If Not r Is Nothing Then arr(i, 3) = r.Offset(, 1).Value
        Next
        .Value = arr
    End With
End Sub
[/vba]

3342527.xls

Автор - krosav4ig
Дата добавления - 18.02.2019 в 15:46
benza89 Дата: Понедельник, 18.02.2019, 16:15 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 34
Репутация: 0 ±
Замечаний: 20% ±

Excel 2003
krosav4ig, к сожалению выдает ошибку "invalid use of me keyword", ругается на "Me.UsedRange.Columns("B:E")"
Поменяла на Sheets("Лист2").Range("B2:E200") всё работает и быстро, спасибо Вам преогромнейшее за макрос!


Сообщение отредактировал benza89 - Понедельник, 18.02.2019, 16:46
 
Ответить
Сообщениеkrosav4ig, к сожалению выдает ошибку "invalid use of me keyword", ругается на "Me.UsedRange.Columns("B:E")"
Поменяла на Sheets("Лист2").Range("B2:E200") всё работает и быстро, спасибо Вам преогромнейшее за макрос!

Автор - benza89
Дата добавления - 18.02.2019 в 16:15
krosav4ig Дата: Понедельник, 18.02.2019, 17:17 | Сообщение № 4
Группа: Друзья
Ранг: Старожил
Сообщений: 2346
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Вот жеж, совсем забыл файл прикрепить
К сообщению приложен файл: 3342527.xls (42.0 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеВот жеж, совсем забыл файл прикрепить

Автор - krosav4ig
Дата добавления - 18.02.2019 в 17:17
Мир MS Excel » Вопросы и решения » Вопросы по VBA » перенос данных с одного листа на другой в другие ячейки (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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