Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Макрос: Копирование значения предыдущей ячейки, если в параллельном столбце ячейки непустые
 
#1
11.03.2010 12:29:31
Доброго времени суток! Подскажите, пожалуйста, дилетанту, как заставить макрос выполнять следующую задачу. Предположим, что есть формула в ячейке B1, которую надо протащить(скопировать) вниз во все ячейки столбца В до конца таблицы, а именно: до последней непустой ячейки в столбце А. То есть макрос должен проверять, если ячейка в столбце А непустая, тогда копировать в ячейку стобца В значение из верхней ячейки этого же столбца В,а если же ячейка в столбце А пустая (таблица закончилась),то задание выполнено. Прописать определенный диапазон ячеек для заполнения невозможно, поскольку количество строк в таблице может меняться. Строк очень много, обычно порядка 10-15 тысяч. Находила решение подобной задачи, но без условия проверки столбца А на наличие непустых ячеек. Сама решить проблему не могу, тк никогда макросы не писала, а очень надо(((
 
 
 
#2
11.03.2010 12:34:25

Заполнение пустых ячеек: http://www.planetaexcel.ru/tip.php?aid=86
 
 
 
#3
11.03.2010 12:50:37
vikttur, я читала эту статью и знаю описанный в ней способ. Но мне нужно именно в МАКРОС прописать это действие. В комментариях к статье пользователь Элина написала макро-кодировкой, как можно это сделать:  
 
"Элина  
08.11.2007 Лучше сделать макросом. Выделить весь диапазон который надо заполнить и запустить макрос  
Sub CopyCells()  
'  
' В выделенном вертикальном диапазоне (клетки по столбцу к примеру А2:А150)  
' заполнены следующие клетки: А2, А10, А60, А80  
' Макрос позволит размножить значение заполненных клеток на внизлежащие до следующей заполненной  
' Таким образом после выполнения макроса мы получим следующее:  
' диапазон А3-А9 будет заполнен значениями клетки А2  
' диапазон А11-А59 будет заполнен значениями клетки А10  
' диапазон А61-А79 будет заполнен значениями клетки А60  
' диапазон А81-А150 будет заполнен значениями клетки А80  
'  
 
Dim cel As Range  
 
' Цикл перебора клеток выделенного диапазона  
For Each cel In Selection  
' Если клетка со сдвигом вниз на одну позицию Offset(1, 0) пустая = ""  
' то она равна значению текущей клетки  
If cel.Offset(1, 0) = "" Then cel.Offset(1, 0) = cel  
' перемещаемся на клетку вниз  
Next  
 
End Sub. "  
 
 
но здесь нет моего дополнительного условия, чтобы макрос проверял ячейки столбца А на наличие непустых. Самостоятельно дописать макрос не могу(
 
 
 
#4
11.03.2010 12:58:16
мы без Вашего файла тоже ничего писать не будем. потрудитесь накидать пример строк на 50, предварительно заглянув в правила
 
 
 
#5
11.03.2010 13:31:04
Прикреплен максимально упрощенный пример
 
 
 
#6
11.03.2010 13:35:11
Sub Макрос1()  
Dim iLastRow As Long  
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row  
   For i = 3 To iLastRow  
       If Not IsEmpty(Cells(i, 1)) Then  
           Cells(i - 1, 7).Copy Cells(i, 7)  
       End If  
   Next  
End Sub
 
 
 
#7
11.03.2010 13:47:26
Ух как красиво получается :-)) Спасибо большущее, Юрий М!
 
 
 
#8
08.08.2010 12:00:21
Здравствуйте,Уважаемые Специалисты!    
Пожалуйста..помогите исправить макрос..  
 
Sub cut_to_empty()    
Application.ScreenUpdating = False    
Dim cell As Range    
For Each cell In Selection    
Selection.Cut    
Range("I49:I200").Select    
Do While Not IsEmpty(ActiveCell.Value)    
ActiveCell.Offset(1, 0).Select    
Loop    
ActiveSheet.Paste    
Next cell    
Application.CutCopyMode = False    
Application.ScreenUpdating = True    
End Sub  
 
При каждом НОВОМ запуске макроса он должен вставлять НОВЫЙ блок выделенных ячеек после каждого предыдущего блока в указанный диапазон (I49-I200)ЧЕРЕЗ СТРОЧКУ!!!  
Сейчас получается,что НОВЫЙ блок вставляется без пропуска...  
Огромное Вам спасибо!
 
 
 
#9
08.08.2010 13:11:28
Дайте небольшой пример. Что есть и что надо. Может там вообще проще и быстрей можно. Ваш макрос как-то бредово написан. Много лишних(или непонятных без примера) телодвижений.
Я сам - дурнее всякого примера! ...
 
 
 
#10
08.08.2010 13:44:18
Пока так попробуйте:  
Public Sub SergP()  
   Dim lLstr As Long  
   lLstr = Cells(Rows.Count, "I").End(xlUp).Row  
   If lLstr < 49 Then lLstr = 49  
   If lLstr >= 200 Then Exit Sub  
   Selection.Cut Cells(lLstr + 2, "I")  
End Sub
Я сам - дурнее всякого примера! ...
 
 
 
#11
08.08.2010 13:53:01
Спасибо,за отклик,KuklP!:)))  
Вот файл.Помогите,пожалуйста..:))
 
 
 
#12
08.08.2010 14:07:29
Так:  
Public Sub SergP()  
   Dim lLstr As Long  
   lLstr = Cells(Rows.Count, "F").End(xlUp).Row  
   If lLstr < 13 Then lLstr = 13  
   If lLstr >= 200 Then Exit Sub  
   Selection.Cut Cells(lLstr + 2, "F")  
End Sub  
Пробуйте.
Я сам - дурнее всякого примера! ...
 
 
 
#13
08.08.2010 14:16:39
Ваш файл.
Я сам - дурнее всякого примера! ...
 
 
 
#14
08.08.2010 15:16:34
спасибо,разобрался
 
 
 
#15
28.08.2010 21:16:39
помогите плиз.  
как сделать так ,что бы в макросе  
выделение a5:a55    
копирование  
вставка b5:b55 соответственно(что бы а3 копировалось в б3 и  тп)  
при етом если яейка пустая он ее не трогал(т.е. то значение которое есть в b3 не заменилось на пустую клетку)
 
 
 
#16
28.08.2010 21:24:28
Цикл:  
Sub qqq()  
   For i = 3 To 55  
       If Cells(i, 1) <> "" Then Cells(i, 1).Copy Cells(i, 2)  
   Next  
End Sub
 
 
 
#17
28.08.2010 21:53:07
спасибо 2й вариант помог(1й видимо не помог потому что я ламер)))
 
 
 
#18
05.01.2011 23:57:18
{quote}{login=Юрий М}{date=28.08.2010 09:24}{thema=}{post}Цикл:  
............{/post}{/quote}  
Прямым текстом не работает, через Dim i As Integer получается.  
Кто-нибудь подскажет, чтоб ячейки "Cells(i, 2)" имели только значения  
ячеек Cells(i, 1).  
Спасибо огромное!
 
 
 
#19
06.01.2011 00:06:08
If Cells(i, 1) <> "" Then Cells(i, 2).value = Cells(i, 1).value  
Что такое "прямой текст"?
 
 
 
#20
06.01.2011 00:23:51
Во первых большое спасибо! Видимо я применил  ".Value" не в том месте.    
Во вторых я имел в виду скопировать без изменений указанный(предложенный)  
"текст"(естестно куда надо!)
 
 
 
#21
16.11.2011 13:55:10
{quote}{login=Юрий М}{date=28.08.2010 09:24}{thema=}{post}Цикл:  
Sub qqq()  
   For i = 3 To 55  
       If Cells(i, 1) <> "" Then Cells(i, 1).Copy Cells(i, 2)  
   Next  
End Sub{/post}{/quote}  
Юрий, я новичок, поэтому прошу прощения за возможно легкий вопрос. Я использовала Ваш код для своей задачи,но есть небольшое но...., а именно что нужно добавить в код, чтобы копировалась ТОЛЬКО формула (это что-то вроде специальная вставка формулы). В данном коде копируется формула вместе с форматом, а мне это не нужно.
 
 
 
#22
16.11.2011 14:09:49
Если не хотите использовать специальную вставку, попробуйте добавить строку:  
.Style = "Normal"
 
 
 
#23
16.11.2011 14:12:01
{quote}{login=slaska}{date=16.11.2011 01:55}{thema=Re: }{post}Юрий, я новичок, поэтому прошу прощения за возможно легкий вопрос....{/post}{/quote}  
Позволю себе ответить:  
 
Sub qqq()  
For i = 3 To 55  
If Cells(i, 1) <> "" Then Cells(i, 1).Copy  
Cells(i, 2).PasteSpecial xlPasteFormulas  
Next  
End Sub
 
 
 
#24
16.11.2011 14:24:49
{quote}{login=Юрий М}{date=16.11.2011 02:09}{thema=}{post}Если не хотите использовать специальную вставку, попробуйте добавить строку:  
.Style = "Normal"{/post}{/quote}  
А куда именно? не могли бы вставить в этот код  
Sub qqq()  
Dim i As Integer  
   For i = 3 To 20  
       If Cells(i, 7) = "" Then Cells(2, 7).Copy Cells(i, 7)  
   Next  
End Sub
 
 
 
#25
16.11.2011 14:36:47
For i = 3 To 20  
If Cells(i, 7) = "" Then  
Cells(2, 7).Copy Cells(i, 7)  
Cells(i, 7).Style = "Normal"  
end if  
Next  
Или используйте специальную вставку (вариант Niky) - меньше строк :-)
 
 
 
#26
16.11.2011 14:48:15
ок, все получилось. Спасибо
 
 
 
#27
07.03.2012 15:40:56
Передо мной встала новая задача, порывшись в дебрях форума, нашла то,что нужно. Но вот проблема, я не могу разобраться в кодах,чтобы подстроить их под себя. Хочу в этом разобраться сама, но без вашей помощи мне не обойтись!!! Я очень вас прошу, загляните в файл и оставьте пояснения в кодах. А не могу разобраться,что для чего. Заранее благодарна!!!
 
 
 
Страницы: 1
Читают тему
Наверх