заполнение пустых ячеек соседними

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

заполнение пустых ячеек соседними (Макросы/Sub)

GGR

Дата: Вторник, 07.10.2025, 18:44 | Сообщение № 1

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

Ранг: Форумчанин

Сообщений: 130

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

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

Excel 2007

Приветствую всех.Прошу помочь в решении. В листе " База "для столбцов A и C нужен макрос для заполнения пустых ячеек предыдущим значением . На просторах интернета нашла макрос , но после запуска эксель просто завис ( именно из-за столбца С, шел расчет процессов )Я честно ничего в этом не понимаю. Поэтому убрала этот макрос.Данный файл будут заполнять люди старшего возраста, поэтому хочу упростить им выполнение.

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

Сообщение отредактировал GGR - Вторник, 07.10.2025, 21:25

Ответить

i691198

Дата: Вторник, 07.10.2025, 21:15 | Сообщение № 2

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

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

Сообщений: 452

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

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

2016

Добрый вечер. Не очень понятно какие "соседние" значения нужно использовать для заполнения.

Ответить

GGR

Дата: Вторник, 07.10.2025, 21:27 | Сообщение № 3

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

Ранг: Форумчанин

Сообщений: 130

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

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

Excel 2007

i691198, поправила сообщение. Надо заполнить предыдущее значение.

Ответить

i691198

Дата: Вторник, 07.10.2025, 21:42 | Сообщение № 4

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

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

Сообщений: 452

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

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

2016

Попробуйте такой макрос. Запускать с листа "база".
[vba]

Код

Sub Fill()
  With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .EnableEvents = False
  End With
  Dim Lr&, VBook&, VSheet&, i&
  Lr = Cells(Rows.Count, "B").End(xlUp).Row
  For i = 2 To Lr
    If Cells(i, 1) <> "" Then
      VBook = Cells(i, 1)
    Else
      Cells(i, 1) = VBook
    End If
    If Cells(i, 3) <> "" Then
      VSheet = Cells(i, 3)
    Else
      Cells(i, 3) = VSheet
    End If
  Next
  With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
  End With
End Sub

[/vba]

Ответить

GGR

Дата: Вторник, 07.10.2025, 22:07 | Сообщение № 5

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

Ранг: Форумчанин

Сообщений: 130

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

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

Excel 2007

i691198, все отлично работает. Протестировала.Благодарю.Подскажите пожалуйста , а можно код дописать , чтобы на обратную позицию вернуть( т.е без заполненных ячеек)?

Сообщение отредактировал GGR - Вторник, 07.10.2025, 22:37

Ответить

i691198

Дата: Вторник, 07.10.2025, 22:46 | Сообщение № 6

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

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

Сообщений: 452

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

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

2016

Чтобы отменить заполнение нужно где то сохранить предыдущее состояние таблицы. Можно сделать так - после строки [vba]

Код

Lr = Cells(Rows.Count, "B").End(xlUp).Row

[/vba] вставить строку [vba]

Код

Range("A2:C" & Lr).Copy Range("BA2:BC" & Lr)

[/vba] А для отмены заполнения использовать такой макрос.
[vba]

Код

Sub UnFill()
  Dim Lr&
  If Cells(2, "BB") <> "" Then
    With Application
      .ScreenUpdating = False
      .Calculation = xlCalculationManual
      .EnableEvents = False
    End With
    Lr = Cells(Rows.Count, "BB").End(xlUp).Row
    Range("BA2:BC" & Lr).Copy Range("A2:C" & Lr)
    Range("BA2:BC" & Lr).Clear
    With Application
      .ScreenUpdating = True
      .Calculation = xlCalculationAutomatic
      .EnableEvents = True
    End With
  End If
End Sub

[/vba]

Ответить

GGR

Дата: Среда, 08.10.2025, 05:44 | Сообщение № 7

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

Ранг: Форумчанин

Сообщений: 130

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

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

Excel 2007

i691198, я вставила код, но почему то отмены не произошло.Посмотрите пожалуйста,что не так сделала.Файл приложила .
Заполнение работает просто чудесно.Благодарю

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

Ответить

Nic70y

Дата: Среда, 08.10.2025, 15:56 | Сообщение № 8

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

Ранг: Экселист

Сообщений: 9190

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

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

Excel 2010

чисто под Ваш файл
[vba]

Код

Sub u_18()
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    aa = Cells(Rows.Count, "b").End(xlUp).Row
    ab = Application.Max(Range("a1:a" & aa))
    For ac = 1 To ab
        ad = Application.Match(ac, Range("a1:a" & aa), 0) + 1
        If ac < ab Then
            ae = Application.Match(ac + 1, Range("a1:a" & aa), 0) - 1
        Else
            ae = aa
        End If
        af = Range("a" & ad).Value
        If af = "" Then
            Range("a" & ad & ":a" & ae) = ac
        Else
            Range("a" & ad & ":a" & ae).ClearContents
        End If
    Next
    ab = Application.Max(Range("c1:c" & aa))
    For ac = 1 To ab
        ad = Application.Match(ac, Range("c1:c" & aa), 0) + 1
        If ac < ab Then
            ae = Application.Match(ac + 1, Range("c1:c" & aa), 0) - 1
        Else
            ae = aa
        End If
        If af = "" Then
            Range("c" & ad & ":c" & ae) = ac
        Else
            Range("c" & ad & ":c" & ae).ClearContents
        End If
    Next
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
End Sub

[/vba]

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

ЮMoney 41001841029809

Сообщение отредактировал Nic70y - Среда, 08.10.2025, 17:12

Ответить

GGR

Дата: Среда, 08.10.2025, 18:31 | Сообщение № 9

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

Ранг: Форумчанин

Сообщений: 130

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

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

Excel 2007

Nic70y,протестировала. Все работает. Благодарю.

Ответить

заполнение пустых ячеек соседними (Макросы/Sub)

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