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

Вход

Регистрация

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

 

= Мир MS Excel/Перенос данных на другой лист по условию "жирный шрифт" - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Перенос данных на другой лист по условию "жирный шрифт"
ellison_shiny Дата: Четверг, 21.11.2024, 11:52 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 12
Репутация: 0 ±
Замечаний: 0% ±

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

Помогите, пожалуйста, разобраться с формулой. Цель: перенести данные из столбца A на другой лист, если значения в соседнем столбце имеют жирный шрифт.
К сообщению приложен файл: Report.xlsm (19.1 Kb)
 
Ответить
СообщениеДоброе время суток!

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

Автор - ellison_shiny
Дата добавления - 21.11.2024 в 11:52
ellison_shiny Дата: Четверг, 21.11.2024, 16:11 | Сообщение № 2
Группа: Пользователи
Ранг: Новичок
Сообщений: 12
Репутация: 0 ±
Замечаний: 0% ±

Попробовал сделать через макрос. Возникла одна проблема. Как сделать так, чтобы пустые ячейки не учитывались, а пропускались при работе макроса?
К сообщению приложен файл: report2.xlsm (17.5 Kb)
 
Ответить
СообщениеПопробовал сделать через макрос. Возникла одна проблема. Как сделать так, чтобы пустые ячейки не учитывались, а пропускались при работе макроса?

Автор - ellison_shiny
Дата добавления - 21.11.2024 в 16:11
Nic70y Дата: Четверг, 21.11.2024, 17:07 | Сообщение № 3
Группа: Друзья
Ранг: Экселист
Сообщений: 9010
Репутация: 2369 ±
Замечаний: 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
 
Ответить
Сообщениебез удаления/создания листа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]

Автор - Nic70y
Дата добавления - 21.11.2024 в 17:07
ellison_shiny Дата: Четверг, 21.11.2024, 17:32 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 12
Репутация: 0 ±
Замечаний: 0% ±

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


Сообщение отредактировал ellison_shiny - Четверг, 21.11.2024, 17:45
 
Ответить
СообщениеNic70y, спасибо большое! А как изменить макрос так, чтобы обрабатывался и столбец А и столбец B?

Автор - ellison_shiny
Дата добавления - 21.11.2024 в 17:32
Nic70y Дата: Пятница, 22.11.2024, 07:57 | Сообщение № 5
Группа: Друзья
Ранг: Экселист
Сообщений: 9010
Репутация: 2369 ±
Замечаний: 0% ±

Excel 2010
Цитата ellison_shiny, 21.11.2024 в 17:32, в сообщении № 4 ()
обрабатывался
в смысле копировался?
вместо
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, 21.11.2024 в 17:32, в сообщении № 4 ()
обрабатывался
в смысле копировался?
вместо
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]

Автор - Nic70y
Дата добавления - 22.11.2024 в 07:57
ellison_shiny Дата: Пятница, 22.11.2024, 12:19 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 12
Репутация: 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]
К сообщению приложен файл: report18_3.xlsm (21.7 Kb)
 
Ответить
Сообщение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]

Автор - ellison_shiny
Дата добавления - 22.11.2024 в 12:19
Nic70y Дата: Пятница, 22.11.2024, 12:26 | Сообщение № 7
Группа: Друзья
Ранг: Экселист
Сообщений: 9010
Репутация: 2369 ±
Замечаний: 0% ±

Excel 2010
Цитата ellison_shiny, 22.11.2024 в 12:19, в сообщении № 6 ()
Попробовал модифицировать
получилось как надо?


ЮMoney 41001841029809
 
Ответить
Сообщение
Цитата ellison_shiny, 22.11.2024 в 12:19, в сообщении № 6 ()
Попробовал модифицировать
получилось как надо?

Автор - Nic70y
Дата добавления - 22.11.2024 в 12:26
ellison_shiny Дата: Пятница, 22.11.2024, 12:52 | Сообщение № 8
Группа: Пользователи
Ранг: Новичок
Сообщений: 12
Репутация: 0 ±
Замечаний: 0% ±

получилось как надо?

Да, спасибо вам большое за помощь :up:
 
Ответить
Сообщение
получилось как надо?

Да, спасибо вам большое за помощь :up:

Автор - ellison_shiny
Дата добавления - 22.11.2024 в 12:52
  • Страница 1 из 1
  • 1
Поиск:

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