Автор Тема: Excel VBA Макросы: Как подставить данные из одного листа в другой, из одного столбца в другой?  (Прочитано 164 раз)

Оффлайн synthex

  • Посетитель форума
  • Сообщений: 8
Нужно внести изменения на лист 'GOODS', в столбец H по такому принципу.
Если на листе 'GOODS' в столбце H есть фраза из листа 'test', из столбца A, то нужно заменить эту фразу на фразу из листа 'test' из столбца B.

[вложение удалено администратором]

Оффлайн Администратор

  • Administrator
  • Сообщений: 1574
Макрос
Sub Макрос()
   
    Dim sh_src As Worksheet, sh_res As Worksheet, src(), res()
    Dim lr As Long, i As Long, ii As Long
   
   
    '1. Отключение монитора и формул, чтобы ускорить макрос.
    Dim calc As Long: calc = Application.Calculation
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
   
    '2. Присваиваем листам имена, чтобы затем обращаться к листам по именам.
        ' Так наверное удобнее читать и писать код.
    Set sh_src = Worksheets("test")
    Set sh_res = Worksheets("GOODS")
   
    '3. Копирование данных из листов в vba-массивы. С vba-массивами макрос быстрее работает, чем
        ' с эксель-ячейкками.
    ' Поиск последней строки. End не ищет в скрытых строках.
    lr = sh_src.Cells(sh_src.Rows.Count, "A").End(xlUp).Row
    ' Копирование данных из листа в массив.
    src() = sh_src.Range("A2:B" & lr).Value
    lr = sh_res.Cells(sh_res.Rows.Count, "H").End(xlUp).Row
    res() = sh_res.Range("H2:H" & lr).Value
   
    '4. Замена фраз в массиве 'res'.
    For i = 1 To UBound(res)
        For ii = 1 To UBound(src)
            ' Если в массиве-результате есть текст из массива-источника.
                ' Делается проверка, чтобы зря не записывать данные в массив-результат.
                ' Может это ускорит макрос.
            If InStr(res(i, 1), src(ii, 1)) Then
                ' Замена.
                res(i, 1) = Replace(res(i, 1), src(ii, 1), src(ii, 2))
            End If
        Next ii
    Next i
   
    '5. Вставка изменённого массива обратно на лист.
    sh_res.Range("H2").Resize(UBound(res)).Value = res()
   
    '6. Включения.
    Application.Calculation = calc
    Application.ScreenUpdating = True
   
    '7. Сообщение.
    MsgBox "Готово.", vbInformation
   
End Sub

Оффлайн synthex

  • Посетитель форума
  • Сообщений: 8
Уважаемый администратор. Код прекрасно отработал.