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

Вход

Регистрация

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

 

= Мир MS Excel/выбор значений в столбце и последующее форматирование ячейки - Мир MS Excel

  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_, DrMini  
выбор значений в столбце и последующее форматирование ячейки
stragsds Дата: Пятница, 13.07.2018, 14:21 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Здравствуйте. Начинаю изучать эксель но замахнулся на уильяма нашего разработку формы ведомости покупных изделий
Форма имеет несколько листов один рабочий в котором исполнитель вводит данные и несколько рабочих которые в последствии должны формироваться автоматом.
В ходе работы данные копируются на лист "на печать" скрин прилагаю, где в процессе хотелось бы чтоб автоматом обнаруживались заголовки и форматировались по центру и подчеркивались. Например "конденсаторы" или "диоды" вроде решения нашел и собрал макрос (текст прилагаю) но что-то он ругается и до конца не срабатывает.
Сам процесс вижу так:
1. Снятие защиты листа;
2. Выравнивание ячеек в столбце по левому краю и без подчеркивания;
3. Центрирование заголовка таблицы (Наименование)
4. Поиск заголовка с центрированием и подчеркиванием (резисторы конденсаторы ....итд)
в идеале сделать так чтоб названия можно было вводить на листе "данные" и макрос брал их значения для проверки

в результате выдает ошибку, а транзисторы не находит

Сам макрос

[vba]
Код
Sub ПоискДок()

Sheets("На печать").Protect Password:="123", UserInterfaceOnly:=True

With Sheets("На печать").Range("E5:F3000")
.HorizontalAlignment = xlLeft 'текст влево (так по умолчанию)
.Font.Underline = xlUnderlineStyleNone 'текст без подчеркиваний (так по умолчанию)
.Font.Size = 11 '11 шрифт (так по умолчанию)

End With

With Sheets("На печать").Range("E5:F3000")

Set k = .Find("Наименование", LookIn:=xlValues)
If Not k Is Nothing Then
firstResult = k.Address
Do
k.HorizontalAlignment = xlCenter 'столбец "Наименование" по центру
Set k = .FindNext(k)
Loop While Not k Is Nothing And k.Address <> firstResult
End If

End With

With Sheets("На печать").Range("E5:F3000")

Set c = .Find("Диоды", LookIn:=xlValues)
If Not c Is Nothing Then
firstResult = c.Address
Do
c.HorizontalAlignment = xlCenter 'текст "Диоды" по центру
c.Font.Underline = xlUnderlineStyleSingle

Set c = .Find("Диоды", After:=c, LookIn:=xlValues)
Loop While Not c Is Nothing And c.Address <> firstResult
End If

Set d = .Find("Кварцевые резонаторы", LookIn:=xlValues)
If Not d Is Nothing Then
firstResult = d.Address
Do
d.HorizontalAlignment = xlCenter 'текст "Кварцевые резонаторы" по центру
d.Font.Underline = xlUnderlineStyleSingle

Set d = .Find("Кварцевые резонаторы", After:=d, LookIn:=xlValues)
Loop While Not d Is Nothing And d.Address <> firstResult
End If

Set e = .Find("Конденсаторы", LookIn:=xlValues)
If Not e Is Nothing Then
firstResult = e.Address
Do
e.HorizontalAlignment = xlCenter 'текст "Конденсаторы" по центру
e.Font.Underline = xlUnderlineStyleSingle
Set e = .Find("Конденсаторы", After:=e, LookIn:=xlValues)
Loop While Not e Is Nothing And e.Address <> firstResult
End If

Set f = .Find("Микросхемы", LookIn:=xlValues)
If Not f Is Nothing Then
firstResult = f.Address
Do
f.HorizontalAlignment = xlCenter 'текст "Микросхемы" по центру
f.Font.Underline = xlUnderlineStyleSingle
Set f = .Find("Микросхемы", After:=f, LookIn:=xlValues)
Loop While Not f Is Nothing And f.Address <> firstResult
End If

Set r = .Find("Предохранители", LookIn:=xlValues)
If Not r Is Nothing Then
firstResult = r.Address
Do
r.HorizontalAlignment = xlCenter 'текст "Предохранители" по центру
r.Font.Underline = xlUnderlineStyleSingle
Set r = .Find("Предохранители", After:=r, LookIn:=xlValues)
Loop While Not r Is Nothing And r.Address <> firstResult
End If

Set g = .Find("Разъемы", LookIn:=xlValues)
If Not g Is Nothing Then
firstResult = g.Address
Do
g.HorizontalAlignment = xlCenter 'текст "Разъемы" по центру
g.Font.Underline = xlUnderlineStyleSingle
Set g = .Find("Разъемы", After:=g, LookIn:=xlValues)
Loop While Not g Is Nothing And g.Address <> firstResult
End If

Set h = .Find("Резисторы", LookIn:=xlValues)
If Not h Is Nothing Then
firstResult = h.Address
Do
h.HorizontalAlignment = xlCenter 'текст "Резисторы" по центру
h.Font.Underline = xlUnderlineStyleSingle
Set h = .Find("Резисторы", After:=h, LookIn:=xlValues)
Loop While Not h Is Nothing And h.Address <> firstResult
End If

Set m = .Find("Транзисторы", LookIn:=xlValues)
If Not m Is Nothing Then
firstResult = m.Address
Do
m.HorizontalAlignment = xlCenter 'текст "Транзисторы" по центру
m.Font.Underline = xlUnderlineStyleSingle
Set m = .Find("Транзисторы", After:=m, LookIn:=xlValues)
Loop While Not m Is Nothing And m.Address <> firstResult
End If

Set j = .Find("Светодиоды", LookIn:=xlValues)
If Not j Is Nothing Then
firstResult = j.Address
Do
j.HorizontalAlignment = xlCenter 'текст "Светодиоды" по центру
j.Font.Underline = xlUnderlineStyleSingle
Loop While Not j Is Nothing And j.Address <> firstAddress
End If

End With

End Sub
[/vba]
К сообщению приложен файл: 7901343.png (30.8 Kb) · 8705621.png (36.9 Kb)


Сообщение отредактировал stragsds - Пятница, 13.07.2018, 15:20
 
Ответить
СообщениеЗдравствуйте. Начинаю изучать эксель но замахнулся на уильяма нашего разработку формы ведомости покупных изделий
Форма имеет несколько листов один рабочий в котором исполнитель вводит данные и несколько рабочих которые в последствии должны формироваться автоматом.
В ходе работы данные копируются на лист "на печать" скрин прилагаю, где в процессе хотелось бы чтоб автоматом обнаруживались заголовки и форматировались по центру и подчеркивались. Например "конденсаторы" или "диоды" вроде решения нашел и собрал макрос (текст прилагаю) но что-то он ругается и до конца не срабатывает.
Сам процесс вижу так:
1. Снятие защиты листа;
2. Выравнивание ячеек в столбце по левому краю и без подчеркивания;
3. Центрирование заголовка таблицы (Наименование)
4. Поиск заголовка с центрированием и подчеркиванием (резисторы конденсаторы ....итд)
в идеале сделать так чтоб названия можно было вводить на листе "данные" и макрос брал их значения для проверки

в результате выдает ошибку, а транзисторы не находит

Сам макрос

[vba]
Код
Sub ПоискДок()

Sheets("На печать").Protect Password:="123", UserInterfaceOnly:=True

With Sheets("На печать").Range("E5:F3000")
.HorizontalAlignment = xlLeft 'текст влево (так по умолчанию)
.Font.Underline = xlUnderlineStyleNone 'текст без подчеркиваний (так по умолчанию)
.Font.Size = 11 '11 шрифт (так по умолчанию)

End With

With Sheets("На печать").Range("E5:F3000")

Set k = .Find("Наименование", LookIn:=xlValues)
If Not k Is Nothing Then
firstResult = k.Address
Do
k.HorizontalAlignment = xlCenter 'столбец "Наименование" по центру
Set k = .FindNext(k)
Loop While Not k Is Nothing And k.Address <> firstResult
End If

End With

With Sheets("На печать").Range("E5:F3000")

Set c = .Find("Диоды", LookIn:=xlValues)
If Not c Is Nothing Then
firstResult = c.Address
Do
c.HorizontalAlignment = xlCenter 'текст "Диоды" по центру
c.Font.Underline = xlUnderlineStyleSingle

Set c = .Find("Диоды", After:=c, LookIn:=xlValues)
Loop While Not c Is Nothing And c.Address <> firstResult
End If

Set d = .Find("Кварцевые резонаторы", LookIn:=xlValues)
If Not d Is Nothing Then
firstResult = d.Address
Do
d.HorizontalAlignment = xlCenter 'текст "Кварцевые резонаторы" по центру
d.Font.Underline = xlUnderlineStyleSingle

Set d = .Find("Кварцевые резонаторы", After:=d, LookIn:=xlValues)
Loop While Not d Is Nothing And d.Address <> firstResult
End If

Set e = .Find("Конденсаторы", LookIn:=xlValues)
If Not e Is Nothing Then
firstResult = e.Address
Do
e.HorizontalAlignment = xlCenter 'текст "Конденсаторы" по центру
e.Font.Underline = xlUnderlineStyleSingle
Set e = .Find("Конденсаторы", After:=e, LookIn:=xlValues)
Loop While Not e Is Nothing And e.Address <> firstResult
End If

Set f = .Find("Микросхемы", LookIn:=xlValues)
If Not f Is Nothing Then
firstResult = f.Address
Do
f.HorizontalAlignment = xlCenter 'текст "Микросхемы" по центру
f.Font.Underline = xlUnderlineStyleSingle
Set f = .Find("Микросхемы", After:=f, LookIn:=xlValues)
Loop While Not f Is Nothing And f.Address <> firstResult
End If

Set r = .Find("Предохранители", LookIn:=xlValues)
If Not r Is Nothing Then
firstResult = r.Address
Do
r.HorizontalAlignment = xlCenter 'текст "Предохранители" по центру
r.Font.Underline = xlUnderlineStyleSingle
Set r = .Find("Предохранители", After:=r, LookIn:=xlValues)
Loop While Not r Is Nothing And r.Address <> firstResult
End If

Set g = .Find("Разъемы", LookIn:=xlValues)
If Not g Is Nothing Then
firstResult = g.Address
Do
g.HorizontalAlignment = xlCenter 'текст "Разъемы" по центру
g.Font.Underline = xlUnderlineStyleSingle
Set g = .Find("Разъемы", After:=g, LookIn:=xlValues)
Loop While Not g Is Nothing And g.Address <> firstResult
End If

Set h = .Find("Резисторы", LookIn:=xlValues)
If Not h Is Nothing Then
firstResult = h.Address
Do
h.HorizontalAlignment = xlCenter 'текст "Резисторы" по центру
h.Font.Underline = xlUnderlineStyleSingle
Set h = .Find("Резисторы", After:=h, LookIn:=xlValues)
Loop While Not h Is Nothing And h.Address <> firstResult
End If

Set m = .Find("Транзисторы", LookIn:=xlValues)
If Not m Is Nothing Then
firstResult = m.Address
Do
m.HorizontalAlignment = xlCenter 'текст "Транзисторы" по центру
m.Font.Underline = xlUnderlineStyleSingle
Set m = .Find("Транзисторы", After:=m, LookIn:=xlValues)
Loop While Not m Is Nothing And m.Address <> firstResult
End If

Set j = .Find("Светодиоды", LookIn:=xlValues)
If Not j Is Nothing Then
firstResult = j.Address
Do
j.HorizontalAlignment = xlCenter 'текст "Светодиоды" по центру
j.Font.Underline = xlUnderlineStyleSingle
Loop While Not j Is Nothing And j.Address <> firstAddress
End If

End With

End Sub
[/vba]

Автор - stragsds
Дата добавления - 13.07.2018 в 14:21
китин Дата: Пятница, 13.07.2018, 14:49 | Сообщение № 2
Группа: Модераторы
Ранг: Экселист
Сообщений: 7040
Репутация: 1080 ±
Замечаний: 0% ±

Excel 2007;2010;2016
читаем правила, оформляем все по правилам и ждем ответа


Не судите очень строго:я пытаюсь научиться
ЯД 41001877306852
 
Ответить
Сообщениечитаем правила, оформляем все по правилам и ждем ответа

Автор - китин
Дата добавления - 13.07.2018 в 14:49
stragsds Дата: Пятница, 13.07.2018, 15:04 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Во вложении сам файл
сократил до двух листов начал работать то есть все значения находит но полностью зависает.
уже не все
да еще и сам макрос не вижу куда то делся :) плохо когда руки кривые.

Люди добрые помогите советом дельным.
К сообщению приложен файл: 8032633.xls (100.0 Kb)


Сообщение отредактировал stragsds - Пятница, 13.07.2018, 15:06
 
Ответить
СообщениеВо вложении сам файл
сократил до двух листов начал работать то есть все значения находит но полностью зависает.
уже не все
да еще и сам макрос не вижу куда то делся :) плохо когда руки кривые.

Люди добрые помогите советом дельным.

Автор - stragsds
Дата добавления - 13.07.2018 в 15:04
Pelena Дата: Пятница, 13.07.2018, 15:10 | Сообщение № 4
Группа: Админы
Ранг: Местный житель
Сообщений: 19603
Репутация: 4660 ±
Замечаний: ±

Excel 365 & Mac Excel
stragsds, код надо не под спойлер класть, а оформлять тегами с помощью кнопки # в режиме правки поста. Исправьте свой первый пост


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
Сообщениеstragsds, код надо не под спойлер класть, а оформлять тегами с помощью кнопки # в режиме правки поста. Исправьте свой первый пост

Автор - Pelena
Дата добавления - 13.07.2018 в 15:10
stragsds Дата: Пятница, 13.07.2018, 15:13 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
stragsds, код надо не под спойлер класть, а оформлять тегами с помощью кнопки # в режиме правки поста.


Виноват дурак исправлюсь :)
 
Ответить
Сообщение
stragsds, код надо не под спойлер класть, а оформлять тегами с помощью кнопки # в режиме правки поста.


Виноват дурак исправлюсь :)

Автор - stragsds
Дата добавления - 13.07.2018 в 15:13
Kuzmich Дата: Пятница, 13.07.2018, 16:51 | Сообщение № 6
Группа: Проверенные
Ранг: Ветеран
Сообщений: 717
Репутация: 159 ±
Замечаний: 0% ±

Excel 2003
Цитата
в идеале сделать так чтоб названия можно было вводить на листе "данные" и макрос брал их значения для проверки

На листе "данные" в столбце К, начиная с К2, все наименования
[vba]
Код
Sub Poisk_Doc()
Dim Arr
Dim i As Integer
Dim FoundNaimenovanie As Range
  Arr = Range("K2:K" & Cells(Rows.Count, "K").End(xlUp).Row).Value
With Sheets("На печать").Range("E5:F3000")
  For i = 1 To UBound(Arr)
     Set FoundNaimenovanie = .Find(Arr(i, 1), , xlValues, xlWhole)
     If Not FoundNaimenovanie Is Nothing Then
        FoundNaimenovanie.HorizontalAlignment = xlCenter            'текст по центру
        FoundNaimenovanie.Font.Underline = xlUnderlineStyleSingle
     End If
  Next
End With
End Sub
[/vba]
 
Ответить
Сообщение
Цитата
в идеале сделать так чтоб названия можно было вводить на листе "данные" и макрос брал их значения для проверки

На листе "данные" в столбце К, начиная с К2, все наименования
[vba]
Код
Sub Poisk_Doc()
Dim Arr
Dim i As Integer
Dim FoundNaimenovanie As Range
  Arr = Range("K2:K" & Cells(Rows.Count, "K").End(xlUp).Row).Value
With Sheets("На печать").Range("E5:F3000")
  For i = 1 To UBound(Arr)
     Set FoundNaimenovanie = .Find(Arr(i, 1), , xlValues, xlWhole)
     If Not FoundNaimenovanie Is Nothing Then
        FoundNaimenovanie.HorizontalAlignment = xlCenter            'текст по центру
        FoundNaimenovanie.Font.Underline = xlUnderlineStyleSingle
     End If
  Next
End With
End Sub
[/vba]

Автор - Kuzmich
Дата добавления - 13.07.2018 в 16:51
  • Страница 1 из 1
  • 1
Поиск:

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