объединение ячеек

Программирование на Visual Basic for Applications
Tuco
Постоялец
Постоялец
 
Сообщения: 508
Зарегистрирован: 18.06.2003 (Ср) 16:37
Откуда: Подмосковье

объединение ячеек

Сообщение Tuco » 19.03.2004 (Пт) 17:36

Здравствуйте!
Помогите, пожалуйста! В экселе в колонке есть много повторяющихся значений (от 3 до 20), которые идут одна за одной. Как можно объединить одинаковые ячейки? (Вручную это сделать трудно из-за большого объёма колонки, более 1500 строк)
"There's more than one way to do it!"

Евген
Обычный пользователь
Обычный пользователь
Аватара пользователя
 
Сообщения: 66
Зарегистрирован: 01.07.2003 (Вт) 14:13
Откуда: СПб

Сообщение Евген » 19.03.2004 (Пт) 17:47

Код: Выделить всё
x=1 ' строка с которой начинать
y=1 ' столбец который нужен (A-1, B-2 и тд)
k=x
do while cells(x,y).value<>""
if cells(x,y).value<>cells(k,y).value then
range(cells(k,y), cells(x-1,y).MergeCells=true
k=x
end if
x=x+1
loop


вставляай это в макрос и пускай
Ёж птица гордая, пока не пнешь - не полетит!

Tuco
Постоялец
Постоялец
 
Сообщения: 508
Зарегистрирован: 18.06.2003 (Ср) 16:37
Откуда: Подмосковье

Сообщение Tuco » 19.03.2004 (Пт) 17:53

так объединило только первую группу, а их больше 300... :(
"There's more than one way to do it!"

Евген
Обычный пользователь
Обычный пользователь
Аватара пользователя
 
Сообщения: 66
Зарегистрирован: 01.07.2003 (Вт) 14:13
Откуда: СПб

Сообщение Евген » 19.03.2004 (Пт) 17:56

Код: Выделить всё
Sub макрос()
x = 1
y = 1
k = x
Application.DisplayAlerts = False
Do While Cells(x, y).Value <> ""
If Cells(x, y).Value <> Cells(k, y).Value Then
Range(Cells(k, y), Cells(x - 1, y)).MergeCells = True
k = x
End If
x = x + 1
Loop

End Sub

так будет вернее
Ёж птица гордая, пока не пнешь - не полетит!

Tuco
Постоялец
Постоялец
 
Сообщения: 508
Зарегистрирован: 18.06.2003 (Ср) 16:37
Откуда: Подмосковье

Сообщение Tuco » 19.03.2004 (Пт) 17:59

Ба-а-а-альшущее спасибо, хотя остаётся последняя группа значений, но это уже не смертельно, можно руками...
"There's more than one way to do it!"

Евген
Обычный пользователь
Обычный пользователь
Аватара пользователя
 
Сообщения: 66
Зарегистрирован: 01.07.2003 (Вт) 14:13
Откуда: СПб

Сообщение Евген » 19.03.2004 (Пт) 18:02

да надо еще строку добавить

If Cells(x, y).Value <> Cells(k, y).Value Or Cells(x + 1, y).Value ="" Then
If Cells(x + 1, y).Value = "" Then x = x + 1
Range(Cells(k, y), Cells(x - 1, y)).MergeCells = True

пжалста :)
Ёж птица гордая, пока не пнешь - не полетит!

Tuco
Постоялец
Постоялец
 
Сообщения: 508
Зарегистрирован: 18.06.2003 (Ср) 16:37
Откуда: Подмосковье

Сообщение Tuco » 22.03.2004 (Пн) 12:52

Ваще супер работает всё! Спасибо! :D
"There's more than one way to do it!"


Вернуться в VBA

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 12

    TopList