Перенос данных на другой лист по условию "жирный шрифт"

Старая форма входа

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

Перенос данных на другой лист по условию "жирный шрифт" (Формулы/Formulas)

ellison_shiny

Дата: Четверг, 21.11.2024, 11:52 | Сообщение № 1

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

Ранг: Новичок

Сообщений: 19

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

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

Доброе время суток!

Помогите, пожалуйста, разобраться с формулой. Цель: перенести данные из столбца A на другой лист, если значения в соседнем столбце имеют жирный шрифт.

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

Ответить

ellison_shiny

Дата: Четверг, 21.11.2024, 16:11 | Сообщение № 2

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

Ранг: Новичок

Сообщений: 19

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

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

Попробовал сделать через макрос. Возникла одна проблема. Как сделать так, чтобы пустые ячейки не учитывались, а пропускались при работе макроса?

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

Ответить

Nic70y

Дата: Четверг, 21.11.2024, 17:07 | Сообщение № 3

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

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

Сообщений: 9028

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

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

Excel 2010

без удаления/создания листа2
[vba]

Код

Sub CopyCell()
    Application.DisplayAlerts = False
    a = Sheets("Лист2").Cells(Rows.Count, "a").End(xlUp).Row
    Sheets("Лист2").Rows("1:" & a).Delete
    b = Sheets("Лист1").Cells(Rows.Count, "b").End(xlUp).Row
    For c = 2 To b
        d = Sheets("Лист1").Range("b" & c).Value
        e = Sheets("Лист1").Range("b" & c).Font.Bold
        If d <> "" And e Then
            f = Sheets("Лист2").Cells(Rows.Count, "a").End(xlUp).Row
            g = Sheets("Лист2").Cells(Rows.Count, "a").End(xlUp).Value
            h = 1
            If g = "" Then h = 0
            Sheets("Лист1").Range("b" & c).Copy Sheets("Лист2").Range("a" & f + h)
        End If
    Next
    Application.ScreenUpdating = True
End Sub

[/vba]

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

ЮMoney 41001841029809

Сообщение отредактировал Nic70y - Четверг, 21.11.2024, 17:08

Ответить

ellison_shiny

Дата: Четверг, 21.11.2024, 17:32 | Сообщение № 4

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

Ранг: Новичок

Сообщений: 19

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

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

Nic70y, спасибо большое! А как изменить макрос так, чтобы обрабатывался и столбец А и столбец B?

Сообщение отредактировал ellison_shiny - Четверг, 21.11.2024, 17:45

Ответить

Nic70y

Дата: Пятница, 22.11.2024, 07:57 | Сообщение № 5

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

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

Сообщений: 9028

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

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

Excel 2010

Цитата ellison_shiny, 21.11.2024 в 17:32, в сообщении № 4 (

)

обрабатывался

в смысле копировался?
вместо

Цитата Nic70y, 21.11.2024 в 17:07, в сообщении № 3 (

)

Sheets("Лист1").Range("b" & c).Copy Sheets("Лист2").Range("a" & f + h)

написать[vba]

Код

Sheets("Лист1").Range("a" & c & ":b" & c).Copy Sheets("Лист2").Range("a" & f + h)

[/vba]

ЮMoney 41001841029809

Ответить

ellison_shiny

Дата: Пятница, 22.11.2024, 12:19 | Сообщение № 6

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

Ранг: Новичок

Сообщений: 19

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

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

Nic70y, я имел ввиду, чтобы жирный текст копировался и со столбца A и со столбца B. Попробовал модифицировать макрос (закомментировал строчки кода для себя).
[vba]

Код

Sub CopyCell()
    Application.DisplayAlerts = False
    a = Sheets("Лист2").Cells(Rows.Count, "a").End(xlUp).Row ' определяем последнюю заполненную ячейку в столбце А на листе 2
    Sheets("Лист2").Rows("1:" & a).Delete ' удаляем данные с листа 2
    b = Sheets("Лист1").Cells(Rows.Count, "b").End(xlUp).Row ' определяем последнюю заполненную ячейку в столбце B на листе 1
    For c = 2 To b ' счетчик (от 2 строчки до последней заполненной в столбце B на листе 1)
        d1 = Sheets("Лист1").Range("a" & c).Value ' получаем значения столбца A на листе 1
        d2 = Sheets("Лист1").Range("b" & c).Value ' получаем значения столбца B на листе 1
        e1 = Sheets("Лист1").Range("a" & c).Font.Bold ' получаем свойство ("полужирный текст") столбца A на листе 1
        e2 = Sheets("Лист1").Range("b" & c).Font.Bold ' получаем свойство ("полужирный текст") столбца B на листе 1
        If d1 <> "" And e1 Then ' если значения столбца A на листе 1 непустые и имеют свойство "полужирный текст", тогда:
            f1 = Sheets("Лист2").Cells(Rows.Count, "a").End(xlUp).Row ' определяем последнюю заполненную ячейку в столбце A на листе 2
            g1 = Sheets("Лист2").Cells(Rows.Count, "a").End(xlUp).Value ' определяем значение последней заполненной ячейки в столбце A на листе 2
            h = 1 ' присваиваем h значение 1
            If g1 = "" Then h = 0 ' если ячейка в столбце B на листе 2 пустая, тогда присваиваем h значение 0
            Sheets("Лист1").Range("a" & c).Copy Sheets("Лист2").Range("a" & f1 + h) ' копируем значения столбца A на листе 1 в столбец A на листе 2
        End If
        If d2 <> "" And e2 Then ' если значения столбца B на листе 1 непустые и имеют свойство "полужирный текст", тогда:
            f2 = Sheets("Лист2").Cells(Rows.Count, "b").End(xlUp).Row ' определяем последнюю заполненную ячейку в столбце B на листе 2
            g2 = Sheets("Лист2").Cells(Rows.Count, "b").End(xlUp).Value ' определяем значение последней заполненной ячейки в столбце B на листе 2
            h = 1 ' присваиваем h значение 1
            If g2 = "" Then h = 0 ' если ячейка в столбце B на листе 2 пустая, тогда присваиваем h значение 0
            Sheets("Лист1").Range("b" & c).Copy Sheets("Лист2").Range("b" & f2 + h) ' копируем значения столбца B на листе 1 в столбец B на листе 2
        End If
    Next
    Application.ScreenUpdating = True
End Sub

[/vba]

Код

[/vba]ellison_shiny

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

Ответить

СообщениеNic70y, я имел ввиду, чтобы жирный текст копировался и со столбца A и со столбца B. Попробовал модифицировать макрос (закомментировал строчки кода для себя).
[vba]

Код