Добрый день! Помогите пожалуйста! Задача: Есть диапазон ячеек с данными (пример во вложении) как написать макрос, что б запускаешь его и данные которые находятся в желтом диапазоне обрамлялись в рамочку (границу). Но вот загвоздка... желтый диапазон каждый раз разный будет приходить ..надо что б макрос строго каждый раз обрамлял в границу только те ячейки в которых есть данные...диапазон каждый раз приходит разный только в плане длины столбца...а в ширину по ячейкам всегда один и то же (3 ячейки ширина). Начала диапазона всегда будет строго начинаться с тех ячеек что в примере. А вот в синем столбце что б появлялись номера по порядку строк...1..2..3.. и т. д. тоже в строгом соответствии скоко строк с данными будет..стоко и номеров по порядку. Заранее спасибо.
Добрый день! Помогите пожалуйста! Задача: Есть диапазон ячеек с данными (пример во вложении) как написать макрос, что б запускаешь его и данные которые находятся в желтом диапазоне обрамлялись в рамочку (границу). Но вот загвоздка... желтый диапазон каждый раз разный будет приходить ..надо что б макрос строго каждый раз обрамлял в границу только те ячейки в которых есть данные...диапазон каждый раз приходит разный только в плане длины столбца...а в ширину по ячейкам всегда один и то же (3 ячейки ширина). Начала диапазона всегда будет строго начинаться с тех ячеек что в примере. А вот в синем столбце что б появлялись номера по порядку строк...1..2..3.. и т. д. тоже в строгом соответствии скоко строк с данными будет..стоко и номеров по порядку. Заранее спасибо.ПалычЪ
Sub Обрамление() Dim rng As Range Dim r_s As Long, r_e As Long, c_s As Long, c_e As Long r_s = Cells(1, 2).End(xlDown).Row r_e = Cells(Rows.Count, 2).End(xlUp).Row c_s = Cells(r_s, 1).End(xlToRight).Column c_e = Cells(r_s, Columns.Count).End(xlToLeft).Column Set rng = Range(Cells(r_s, c_s), Cells(r_e, c_e)) For i = 7 To 10 With rng.Borders(i) .Weight = xlMedium End With Next i End Sub
[/vba]
ПалычЪ, добрый день, так можно попробовать: [vba]
Код
Sub Обрамление() Dim rng As Range Dim r_s As Long, r_e As Long, c_s As Long, c_e As Long r_s = Cells(1, 2).End(xlDown).Row r_e = Cells(Rows.Count, 2).End(xlUp).Row c_s = Cells(r_s, 1).End(xlToRight).Column c_e = Cells(r_s, Columns.Count).End(xlToLeft).Column Set rng = Range(Cells(r_s, c_s), Cells(r_e, c_e)) For i = 7 To 10 With rng.Borders(i) .Weight = xlMedium End With Next i End Sub
Sub aaa() Dim iCell As Range, iCell1, iCell2, iStart As Boolean For Each iCell In ActiveSheet.Range("A1:DA" & Cells(Rows.Count, 2).End(xlUp).Row) If iCell.Interior.Color = 65535 Then If iStart = 0 Then: iCell1 = iCell.Address: iStart = True iCell2 = iCell.Address End If Next Set IRange = Range(iCell1, iCell2) IRange.Borders(xlEdgeLeft).Weight = xlThick IRange.Borders(xlEdgeTop).Weight = xlThick IRange.Borders(xlEdgeBottom).Weight = xlThick IRange.Borders(xlEdgeRight).Weight = xlThick End Sub
[/vba]
а я через цвет ячеек предложу
[vba]
Код
Sub aaa() Dim iCell As Range, iCell1, iCell2, iStart As Boolean For Each iCell In ActiveSheet.Range("A1:DA" & Cells(Rows.Count, 2).End(xlUp).Row) If iCell.Interior.Color = 65535 Then If iStart = 0 Then: iCell1 = iCell.Address: iStart = True iCell2 = iCell.Address End If Next Set IRange = Range(iCell1, iCell2) IRange.Borders(xlEdgeLeft).Weight = xlThick IRange.Borders(xlEdgeTop).Weight = xlThick IRange.Borders(xlEdgeBottom).Weight = xlThick IRange.Borders(xlEdgeRight).Weight = xlThick End Sub
Спасибо обоим участникам за участие! Впрос к Роману
Переделайте плиз так чтоб и внутри все ячейки в рамочках были))а не тока по краям...
и второе...строк в табличке что нужно врамку обрамлять может и 400 быть..ну я эт так на всяк случай...мож пригодится макрос передлать...а то попробывал на 300+ строк макрос применить..тока почему то первый столбец в общую рамку обрамляет((((
И..про порядковый номер то не забыли в крайнем левом столбце?))
Спасибо обоим участникам за участие! Впрос к Роману
Переделайте плиз так чтоб и внутри все ячейки в рамочках были))а не тока по краям...
и второе...строк в табличке что нужно врамку обрамлять может и 400 быть..ну я эт так на всяк случай...мож пригодится макрос передлать...а то попробывал на 300+ строк макрос применить..тока почему то первый столбец в общую рамку обрамляет((((
И..про порядковый номер то не забыли в крайнем левом столбце?))ПалычЪ
Сообщение отредактировал ПалычЪ - Воскресенье, 06.12.2015, 00:09
ПалычЪ, Если мой макрос для выделения всё-таки подходит (ток, если на листе находится ничего лишнего кроме выделяемой таблицы), можно так: [vba]
Код
Sub Обрамление2() Dim rng As Range Dim r_s As Long, r_e As Long, c_s As Long, c_e As Long r_s = Cells(1, 2).End(xlDown).Row r_e = Cells(Rows.Count, 2).End(xlUp).Row c_s = Cells(r_s, 1).End(xlToRight).Column c_e = Cells(r_s, Columns.Count).End(xlToLeft).Column Set rng = Range(Cells(r_s, c_s), Cells(r_e, c_e)) For i = 7 To 12 With rng.Borders(i) .Weight = xlMedium End With Next i For i = r_s To r_e Cells(i, 1) = i + 1 - r_s Next i End Sub
[/vba]
ПалычЪ, Если мой макрос для выделения всё-таки подходит (ток, если на листе находится ничего лишнего кроме выделяемой таблицы), можно так: [vba]
Код
Sub Обрамление2() Dim rng As Range Dim r_s As Long, r_e As Long, c_s As Long, c_e As Long r_s = Cells(1, 2).End(xlDown).Row r_e = Cells(Rows.Count, 2).End(xlUp).Row c_s = Cells(r_s, 1).End(xlToRight).Column c_e = Cells(r_s, Columns.Count).End(xlToLeft).Column Set rng = Range(Cells(r_s, c_s), Cells(r_e, c_e)) For i = 7 To 12 With rng.Borders(i) .Weight = xlMedium End With Next i For i = r_s To r_e Cells(i, 1) = i + 1 - r_s Next i End Sub
Sub Обрамление3() Dim rng As Range Dim r_s As Long, r_e As Long, c_s As Long, c_e As Long For Each rng In ActiveSheet.UsedRange If rng.Interior.Color = 65535 Then If r_s <> 0 Then If r_s > rng.Row Then r_s = rng.Row Else: r_s = rng.Row End If If r_e < rng.Row Then r_e = rng.Row If c_s <> 0 Then If c_s > rng.Column Then c_s = rng.Column Else: c_s = rng.Column End If If c_e < rng.Column Then c_e = rng.Column End If Next rng Set rng = Range(Cells(r_s, c_s), Cells(r_e, c_e)) For i = 7 To 12 With rng.Borders(i) .Weight = xlMedium End With Next i For i = r_s To r_e Cells(i, 1) = i + 1 - r_s Next i End Sub
[/vba]
Либо так, если всё же надо по цвету: [vba]
Код
Sub Обрамление3() Dim rng As Range Dim r_s As Long, r_e As Long, c_s As Long, c_e As Long For Each rng In ActiveSheet.UsedRange If rng.Interior.Color = 65535 Then If r_s <> 0 Then If r_s > rng.Row Then r_s = rng.Row Else: r_s = rng.Row End If If r_e < rng.Row Then r_e = rng.Row If c_s <> 0 Then If c_s > rng.Column Then c_s = rng.Column Else: c_s = rng.Column End If If c_e < rng.Column Then c_e = rng.Column End If Next rng Set rng = Range(Cells(r_s, c_s), Cells(r_e, c_e)) For i = 7 To 12 With rng.Borders(i) .Weight = xlMedium End With Next i For i = r_s To r_e Cells(i, 1) = i + 1 - r_s Next i End Sub
Рома ваще все классно..последняя просьба..в подробности вдоваться не буду... нужно макрос так переделать что б нумерация начиналась на две строки ниже...пожалуйста...
мне подошел вариант без цвета
Рома ваще все классно..последняя просьба..в подробности вдоваться не буду... нужно макрос так переделать что б нумерация начиналась на две строки ниже...пожалуйста...
Если мой макрос для выделения всё-таки подходит (ток, если на листе находится ничего лишнего кроме выделяемой таблицы), можно так:
Находится...еще 2 строки..оглавление таблицы самой..находятся эти 2-е строки аккурат над этой таблицей... пример перезалил.... и согласен сразу не то чтото пошло...(( вначале про ето не написал про эти две строки..думал это не важно при написании макроса(( а глюк пошол такой...что обрамляться стало тока в ОБЩУЮ рамку....и тока столбец B
кстати надо что б еще и порядковые номера в рамку обрамлялись слева(((
Если мой макрос для выделения всё-таки подходит (ток, если на листе находится ничего лишнего кроме выделяемой таблицы), можно так:
Находится...еще 2 строки..оглавление таблицы самой..находятся эти 2-е строки аккурат над этой таблицей... пример перезалил.... и согласен сразу не то чтото пошло...(( вначале про ето не написал про эти две строки..думал это не важно при написании макроса(( а глюк пошол такой...что обрамляться стало тока в ОБЩУЮ рамку....и тока столбец B
кстати надо что б еще и порядковые номера в рамку обрамлялись слева(((ПалычЪ
ПалычЪ, Если Ваша таблица всё-таки начинается с ячейки A1, то можно так [vba]
Код
Sub Обрамление2() Dim rng As Range Dim r_s As Long, r_e As Long, c_s As Long, c_e As Long r_s = 1 r_e = Cells(Rows.Count, 2).End(xlUp).Row c_s = 1 c_e = Cells(r_e, Columns.Count).End(xlToLeft).Column Set rng = Range(Cells(r_s, c_s), Cells(r_e, c_e)) For i = 7 To 12 With rng.Borders(i) .Weight = xlMedium End With Next i For i = r_s + 3 To r_e Cells(i, 1) = i - 2 - r_s Next i End Sub
[/vba]
ПалычЪ, Если Ваша таблица всё-таки начинается с ячейки A1, то можно так [vba]
Код
Sub Обрамление2() Dim rng As Range Dim r_s As Long, r_e As Long, c_s As Long, c_e As Long r_s = 1 r_e = Cells(Rows.Count, 2).End(xlUp).Row c_s = 1 c_e = Cells(r_e, Columns.Count).End(xlToLeft).Column Set rng = Range(Cells(r_s, c_s), Cells(r_e, c_e)) For i = 7 To 12 With rng.Borders(i) .Weight = xlMedium End With Next i For i = r_s + 3 To r_e Cells(i, 1) = i - 2 - r_s Next i End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
