Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
условие
 
#1
15.10.2009 20:44:32
Здравствуйте  
Подскажите добавить условие больше 100 но игнорировать если уже есть строка с низу.  
 
Option Explicit  
 
Private Sub Worksheet_Change(ByVal Target As Range)  
   If Target.Count > 1 Then Exit Sub  
   If Target.Column <> 1 Or Target = "" Then Exit Sub  
   If Target.Column <> 1 Or Target = "" Then Exit Sub  
   With Application  
       If .CountA(Range("A:A")) > 100 Then Exit Sub  
       .ScreenUpdating = False  
       .EnableEvents = False  
       If .CountA(Range(Cells(Target.Row + 1, 2), Cells(Target.Row + 1, 34))) = 0 Then  
           ActiveSheet.Unprotect  
           Range(Cells(Target.Row, 1), Cells(Target.Row, 34)).Copy Cells(Target.Row + 1, 1)  
           Range(Cells(Target.Row + 1, 1), Cells(Target.Row + 1, 33)).ClearContents  
           ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True  
       End If  
       .ScreenUpdating = True  
       .EnableEvents = True  
   End With  
End Sub
 
 
 
#2
15.10.2009 20:56:07
А Вы не могли бы описать замысел того, что Вы делаете и хотите получить?  
Сломался после того, как 2 раза прочел условие  
If Target.Column <> 1 Or Target = "" Then Exit Sub  
If Target.Column <> 1 Or Target = "" Then Exit Sub  
При этом >1 еще понимаю, но вот где спрятаны столбцы <1?  
И какие текстовые данные расположены в столбце А. И проверяете Вы что в столбце введено 100 значений, или нужно определить строку=100?
 
 
 
#3
15.10.2009 21:08:39
Мне в принципе необходимо чтобы добавление строк происходило как после серой ячейки 1 так и после серой ячейки 2. А во обще то серых ячеек с нижней строкой будет 15 штук.
 
 
 
#4
15.10.2009 21:20:32
{quote}{login=}{date=15.10.2009 09:08}{thema=}{post}Мне в принципе необходимо чтобы добавление строк происходило как после серой ячейки 1 так и после серой ячейки 2. А во обще то серых ячеек с нижней строкой будет 15 штук.{/post}{/quote}  
А можно еще раз про добавление и серую строку?  
.CountA(Range("A:A")) у Вас не будет работать у Вас вводимые значения числовые в столбце А, это просто .Count(Range("A:A")), но не совсем уверен что ВБА легко проглатывает такие размерности. Может Вам использовать    
 
.Count(Range("A6:A" & Cells(Rows.Count,"A" ).End(xlUp).Row)  
 
Private Sub Worksheet_Change(ByVal Target As Range)  
If Target.cells.Count > 1 Then Exit Sub  
If Target.Column = 1    
If Target <> "" Then    
With Application  
if .Count(Range("A6:A" & Cells(Rows.Count,"A" ).End(xlUp).Row) <= 100 then  
......  
....  
end if  
end with  
end if  
end if  
end sub
 
 
 
#5
15.10.2009 21:37:31
При выборе значения чистой ячейки (после серой ячейки) столбца А должно происходить добавление такой же строки с низу.
 
 
 
#6
15.10.2009 23:26:42
Кранты.
 
 
 
#7
16.10.2009 10:01:29
{quote}{login=}{date=15.10.2009 11:26}{thema=}{post}Кранты.{/post}{/quote}  
И почему так печально?  
Кстати Вы так и не ответили на вопросы.  
Кто красит ячейки серым, почему их 15, и что необходимо копировать строки сразу в 15-?  
Когда будет понятно что делать, то может в воскресенье вечером еще посмотрю.  
И еще, писал Вам кое какие измения, что не помогает?  
Игорь67
 
 
 
#8
16.10.2009 18:17:05
Код как то работает, но толи Вам надо не знаю. Вы так и не ответили на мои вопросы.  
Подчистил ошибки (явные) типа Copy  есть, а куда вставить нет:)  
Игорь67  
 
Private Sub Worksheet_Change(ByVal Target As Range)  
Dim v As Long  
If Target.Cells.Count > 1 Then Exit Sub  
If Target.Column = 1 Then  
   If Target.Row > 5 Then  
       If Target <> "" Then  
With Application  
   If .Count(Range("A6:A" & Cells(Rows.Count, "A").End(xlUp).Row)) <= 100 Then  
'у Вас в 34 столбце всегда есть значение, поэтому проверяем или до 33, или можно SUM()=0          
v = .Count(Range(Cells(Target.Row + 1, 2), Cells(Target.Row + 1, 33)))  
       If v = 0 Then  
 
       .ScreenUpdating = False  
       .EnableEvents = False  
        .ActiveSheet.Unprotect  
 
           Range(Cells(Target.Row, 1), Cells(Target.Row, 34)).Copy Destination:=Cells(Target.Row + 1, 1)  
           Range(Cells(Target.Row + 1, 1), Cells(Target.Row + 1, 33)).ClearContents  
           .ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True  
       .ScreenUpdating = True  
       .EnableEvents = True  
 
 
       End If  
   End If  
End With  
 
       End If  
   End If  
End If  
 
End Sub
 
 
 
Страницы: 1
Читают тему
Наверх