|
Внимание, важное сообщение: Дорогие Друзья!
В ноябре далекого 2001 года мы решили создать сайт и форум, которые смогут помочь как начинающим, так и продвинутым пользователям разобраться в операционных системах. В 2004-2006г наш проект был одним из самых крупных ИТ ресурсов в рунете, на пике нас посещало более 300 000 человек в день! Наша документация по службам Windows и автоматической установке помогла огромному количеству пользователей и сисадминов. Мы с уверенностью можем сказать, что внесли большой вклад в развитие ИТ сообщества рунета. Но... время меняются, приоритеты тоже. И, к сожалению, пришло время сказать До встречи! После долгих дискуссий было принято решение закрыть наш проект. 1 августа форум переводится в режим Только чтение, а в начале сентября мы переведем рубильник в положение Выключен Огромное спасибо за эти 24 года, это было незабываемое приключение. Сказать спасибо и поделиться своей историей можно в данной теме. С уважением, ваш призрачный админ, BigMac... |
|
| Компьютерный форум OSzone.net » Сфера Microsoft » Microsoft Office (Word, Excel, Outlook и т.д.) » 2003/XP/2000 - [решено] Разъединить ячейку с копированием значения в результирующий набор |
|
|
2003/XP/2000 - [решено] Разъединить ячейку с копированием значения в результирующий набор
|
|
Ветеран Сообщения: 565 |
Есть объединенная ячейка, которую хотелось бы разъединить так, чтобы исходное значение скопировалось во все результирующие ячейки.
Для простоты возьмем, что объединены они только в одном столбце и не более чем по 10 ячеек Написал макрос: Sub UnmergeCells()
Dim iROW As Integer, iColumn As Integer, sTMP As String, i As Integer, s As Object
Application.ScreenUpdating = False
s = ActiveCell.Cells
For iROW = 0 To 10
ActiveWorkbook.ActiveSheet.Cells(s.Row + iROW, s.Column).MergeArea.UnMerge
Next iROW
s.Select
'Range("A3").Select
iROW = 1
Do While Not IsEmpty(ActiveCell)
i = iROW - 1
If ActiveCell.Offset(iROW, 0).Value = "" Then
ActiveCell.Offset(iROW, 0).Value = s.Value
End If
iROW = iROW + 1
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Где ошибся? Может, у кого готовое решение есть, задача-то известная... |
|
|
------- Отправлено: 07:11, 02-04-2010 |
|
Ветеран Сообщения: 565
|
Профиль | Сайт | Отправить PM | Цитировать Пардон, сам разобрался. Конечный вариант(разъединяет текущую ячейку вниз)
Sub UNM()
Dim iROW As Integer, iColumn As Integer, sTMP As String, i As Integer, s As Range
Application.ScreenUpdating = False
Set s = ActiveCell
If ActiveWorkbook.ActiveSheet.Cells(s.Row + iROW, s.Column).MergeCells Then
i = ActiveWorkbook.ActiveSheet.Cells(s.Row + iROW, s.Column).MergeArea.Count - 1
ActiveWorkbook.ActiveSheet.Cells(s.Row + iROW, s.Column).MergeArea.UnMerge
End If
s.Select
ActiveCell.Offset(1, 0).Select
Do While IsEmpty(ActiveCell) And i > 0
i = i - 1
ActiveCell.Value = s.Value
ActiveCell.Offset(1, 0).Select
Loop
End Sub
|
|
------- Отправлено: 07:29, 02-04-2010 | #2 |
|
Технолог Сообщения: 819
|
Профиль | Отправить PM | Цитировать |
|
Последний раз редактировалось Pliomera, 03-04-2010 в 00:10. Отправлено: 23:40, 02-04-2010 | #3 |
|
|
Участник сейчас на форуме |
|
Участник вне форума |
![]() |
Автор темы |
![]() |
Сообщение прикреплено |
| |||||
| Название темы | Автор | Информация о форуме | Ответов | Последнее сообщение | |
| Проблема с выделением и копированием в ХР | lusia1994 | Microsoft Windows 2000/XP | 1 | 30-03-2007 15:32 | |
| iframe, не нужен мне скроллинг, увеличивай ячейку... | Drem | Вебмастеру | 5 | 02-08-2006 01:27 | |
| Разъединить один столбец на столбцы в екселе | The Lucifier | Программное обеспечение Windows | 7 | 07-06-2006 00:54 | |
| Проблемы с копированием файлов | KVAnt | Microsoft Windows NT/2000/2003 | 7 | 17-08-2005 06:13 | |
| Проблема с копированием. | QRZ57 | Оптические приводы | 11 | 03-05-2005 18:26 | |
|