Замена формул макросом

Страница 1 из 1 1
Модератор форума: китин, _Boroda_, DrMini

Литр

Дата: Пятница, 24.04.2026, 14:49 | Сообщение № 1

Группа: Пользователи

Ранг: Участник

Сообщений: 67

Репутация: 0 ±

Замечаний: 0% ±

2013

Уважаемые спецы!
Хочу разгрузить лист от обилия однотипных формул, прошу подсказать как спрятать все вычисления в VBA

Имеем в Е2:

Код

=ЕСЛИОШИБКА(ИНДЕКС(СПИСОК!$B$1:$B$100;ПОИСКПОЗ(D2;СПИСОК!$A$1:$A$100;0));"")

и в Н2

Код

=ЕСЛИ(ИЛИ(F2="";G2="");"";СЦЕПИТЬ(F2;" – ";G2))

Соответственно они протянуты со второй строки и пока до 1500. в Месяц лист прибавляет по 300-400 строк.
Как я себе представляю код можно вставить в модуль листа, что бы при изменении в ячейках столбца D в соответствующую ячейку столбца Е попадал результат вычисления первой функции, и при изменениях в столбцах F или G результат попадал в столбца Н соответствующего ряда

Прошу помочь

Сообщение отредактировал Литр - Пятница, 24.04.2026, 15:56

Ответить

MikeVol

Дата: Суббота, 25.04.2026, 16:02 | Сообщение № 2

Группа: Проверенные

Ранг: Обитатель

Сообщений: 486

Репутация: 120 ±

Замечаний: 0% ±

MSO LTSC 2021 EN

Литр, Файл пример бы от вас по структуре ориганла и несколько строк с данными (импровизированными) для тестирования. Лень самому создавать пример.

Ученик.
Одесса - Украина

Ответить

gling

Дата: Суббота, 25.04.2026, 21:37 | Сообщение № 3

Группа: Друзья

Ранг: Участник клуба

Сообщений: 2707

Репутация: 775 ±

Замечаний: 0% ±

2010

Цитата Литр, 24.04.2026 в 14:49, в сообщении № 1 (

)

код можно вставить в модуль листа

Попробуйте вставить[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
    If Target.Column = 4 Then
        i = Application.Match(Target.Value, Sheets("СПИСОК").Range("A1:A100"), 0)
        If i > 0 Then Range("E" & Target.Row) = Range("B" & i).Value
    End If
    If Not Intersect(Target, Columns("F:G")) Is Nothing Then
        If Range("F" & Target.Row) <> "" And Range("G" & Target.Row) <> "" Then Range("H" & Target.Row) = Range("F" & Target.Row).Value & " - " & Range("G" & Target.Row).Value
    End If
End Sub

[/vba]

ЯД-41001506838083

Ответить

Литр

Дата: Воскресенье, 26.04.2026, 14:50 | Сообщение № 4

Группа: Пользователи

Ранг: Участник

Сообщений: 67

Репутация: 0 ±

Замечаний: 0% ±

2013

gling, вторая часть с функцией СЦЕПИТЬ - работает как положено, а вот с первой частью с ПОИСКПОЗ из листа СПИСОК что то не так.
Во вложенном примере в лист 2026 в Е2 должно быть значение из СПИСОК В7

К сообщению приложен файл: zhurnal2.xlsm (47.0 Kb)

Ответить

gling

Дата: Воскресенье, 26.04.2026, 18:10 | Сообщение № 5

Группа: Друзья

Ранг: Участник клуба

Сообщений: 2707

Репутация: 775 ±

Замечаний: 0% ±

2010

Цитата Литр, 26.04.2026 в 14:50, в сообщении № 4 (

)

а вот с первой частью

Да, упустил, ведь столбец В это на листе СПИСОК, надо добавить название листа. Замените строку на такую[vba]

Код

If i > 0 Then Range("E" & Target.Row).Value = Sheets("СПИСОК").Range("B" & i).Value

[/vba]

ЯД-41001506838083

Ответить

Литр

Дата: Воскресенье, 26.04.2026, 18:36 | Сообщение № 6

Группа: Пользователи

Ранг: Участник

Сообщений: 67

Репутация: 0 ±

Замечаний: 0% ±

2013

gling, Спасибо!!!

Ответить

Литр

Дата: Вторник, 28.04.2026, 07:41 | Сообщение № 7

Группа: Пользователи

Ранг: Участник

Сообщений: 67

Репутация: 0 ±

Замечаний: 0% ±

2013

gling, как исправить: при выборе из выпадающего списка из колонки 4 (D) или при удалении из нее неверно введеного значения появляется ошибка VBA run time error 13

Ответить

MikeVol

Дата: Вторник, 28.04.2026, 07:57 | Сообщение № 8

Группа: Проверенные

Ранг: Обитатель

Сообщений: 486

Репутация: 120 ±

Замечаний: 0% ±

MSO LTSC 2021 EN

[vba]

Код

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub

    If Target.Column = 4 Then

        Dim res     As Variant
        res = Application.Match(Target.Value, ThisWorkbook.Worksheets("СПИСОК").Range("A1:A100"), 0)

        If Not IsError(res) Then
            Range("E" & Target.Row).Value = ThisWorkbook.Worksheets("СПИСОК").Range("B" & res).Value
        Else
            Range("E" & Target.Row).ClearContents
        End If

    End If

    If Not Intersect(Target, Columns("F:G")) Is Nothing Then
        If Range("F" & Target.Row) <> "" And Range("G" & Target.Row) <> "" Then Range("H" & Target.Row) = Range("F" & Target.Row).Value & " - " & Range("G" & Target.Row).Value
    End If

End Sub

[/vba]

Ученик.
Одесса - Украина

Ответить

Замена формул макросом

Страница 1 из 1
1