Условие иф

[ABA2]

Добрыи день.Смастерил код с условием иф, работает но с тормазом.Как улучит этот код, подскажите,пожалуйста.Excel 2003.

Sub Imokos()
Application.ScreenUpdating = False
On Error GoTo ErrHandler
Dim E As Range, x As Range
Set E = Range("D3:D52")
Set x = Range("C3:C52")

If (E(1, 1) > 0) Then x(1, 1).Value = 1
If (E(2, 1) > 0) Then x(2, 1).Value = 1
If (E(3, 1) > 0) Then x(3, 1).Value = 1
If (E(4, 1) > 0) Then x(4, 1).Value = 1
If (E(5, 1) > 0) Then x(5, 1).Value = 1
If (E(6, 1) > 0) Then x(6, 1).Value = 1
If (E(7, 1) > 0) Then x(7, 1).Value = 1
If (E(8, 1) > 0) Then x(8, 1).Value = 1
If (E(9, 1) > 0) Then x(9, 1).Value = 1
If (E(10, 1) > 0) Then x(10, 1).Value = 1
If (E(11, 1) > 0) Then x(11, 1).Value = 1
If (E(12, 1) > 0) Then x(12, 1).Value = 1
If (E(13, 1) > 0) Then x(13, 1).Value = 1
If (E(14, 1) > 0) Then x(14, 1).Value = 1
If (E(15, 1) > 0) Then x(15, 1).Value = 1
If (E(16, 1) > 0) Then x(16, 1).Value = 1
If (E(17, 1) > 0) Then x(17, 1).Value = 1
If (E(18, 1) > 0) Then x(18, 1).Value = 1
If (E(19, 1) > 0) Then x(19, 1).Value = 1
If (E(20, 1) > 0) Then x(20, 1).Value = 1
If (E(21, 1) > 0) Then x(21, 1).Value = 1
If (E(22, 1) > 0) Then x(22, 1).Value = 1
If (E(23, 1) > 0) Then x(23, 1).Value = 1
If (E(24, 1) > 0) Then x(24, 1).Value = 1
If (E(25, 1) > 0) Then x(25, 1).Value = 1
If (E(26, 1) > 0) Then x(26, 1).Value = 1
If (E(27, 1) > 0) Then x(27, 1).Value = 1
If (E(28, 1) > 0) Then x(28, 1).Value = 1
If (E(29, 1) > 0) Then x(29, 1).Value = 1
If (E(30, 1) > 0) Then x(30, 1).Value = 1
If (E(31, 1) > 0) Then x(31, 1).Value = 1
If (E(32, 1) > 0) Then x(32, 1).Value = 1
If (E(33, 1) > 0) Then x(33, 1).Value = 1
If (E(34, 1) > 0) Then x(34, 1).Value = 1
If (E(35, 1) > 0) Then x(35, 1).Value = 1
If (E(36, 1) > 0) Then x(36, 1).Value = 1
If (E(37, 1) > 0) Then x(37, 1).Value = 1
If (E(38, 1) > 0) Then x(38, 1).Value = 1
ExitHandler:
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox Err.Description, vbExclamation
Resume ExitHandler

End Sub

[Казанский]

Вы о циклах не слышали, что ли? о_О

Sub Imokos()
Application.ScreenUpdating = False
On Error GoTo ErrHandler
Dim E(), x(), i&
E = Range("D3:D52").Value
x = Range("C3:C52").Value
For i = 1 To 38
    If E(i, 1) > 0 Then x(i, 1) = 1
Next
Range("C3:C52").Value = x

ExitHandler:
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox Err.Description, vbExclamation
Resume ExitHandler

End Sub

[ABA2]

Слышал-но нипалучаетса.
Отлично работает.Спосибо.

[Казанский]

Или так, с использованием формулы листа

Sub Imokos()

Range("C3:C52").Value = Evaluate("IF(D3:D52>0,1,IF(C3:C52="""","""",C3:C52))")

End Sub

[DiemonStar]

а не проще сделать так:

Sub Imokos()
  Set x = Range("C3:C52")
  x.FormulaR1C1Local = "=ЕСЛИ(RC[1]>0;1;"""")"
  x = x.Value
End Sub

з.ы. опоздал)

[ABA2]

Казанский ваша вставка формулы выдает #NAME?.И в 2003 и в 2007

DiemonStar вставка формулы отлично работает.Спасибо.
Вазмем код с циклом.
Спасибо всем.

[Казанский]

В моем коде нет вставки формулы. Он работает в 2000 и в 2007.
И он сохраняет прежнее значение ячеек С3:С52, если туда не записывается 1.

[ABA2]

Понятно, но несовсем.
Вазмем код с циклом.