Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Mакрос перебора строк и очистки диапазона по условию, Run-time error '13' type mismatch
 
#1
17.10.2017 11:24:16
Добрый день.
Есть макрос перебора строк и очистки диапазона по условию, но компилятор выдает ошибку на 4 строку.
Не могу разобраться в чем проблема
Код
Dim i&
    For i = 9 To 208 Step 1
        If Range("A" & i).Value = 0 Then
            ActiveSheet.Range("E" & Rows(i) & ":AI" & Rows(i)).Select ' ошибка Run-time error '13' type mismatch
            Selection.ClearContents
        End If
    Next i
 
 
 
#2
17.10.2017 11:35:06
web-master,
Код
If Range("A" & i).Value = 0 Then
            ActiveSheet.Range("E" & i & ":AI" & i).ClearContents
End If


А еще лучше так:
Код
Sub A()
Dim i&, clearRn As Range
    For i = 9 To 208 Step 1
        If Cells(i, 1).Value = 0 Then
' Добавление выбранных ячеек к диапазону
            If clearRn Is Nothing Then
                Set clearRn = Range("E" & i & ":AI" & i)
            Else
                Set clearRn = Union(clearRn, Range("E" & i & ":AI" & i))
            End If
            
        End If
    Next i
' Очистка не каждого диапазона по отдельности, а скопом
    clearRn.ClearContents
End Sub
Изменено: tolstak - 17.10.2017 11:39:16
In GoTo we trust
 
 
 
#3
17.10.2017 11:51:10
Еще вариант:
Код
Sub BB()
    Dim i As Long, x As Range
    For i = 9 To 208
        If Cells(i, 1) = 0 Then If x Is Nothing Then Set x = Cells(i, 1) Else Set x = Union(x, Cells(i, 1))
    Next
    If Not x Is Nothing Then Intersect(x.EntireRow, [E:AI]).ClearContents
End Sub
Если строки с пустым значением в столбце "A" не нужны, то можно и без цикла:
Код
Sub CC()
    [A9:A208].Replace 0, "", xlWhole
    On Error Resume Next
    Intersect([A9:A208].SpecialCells(xlCellTypeBlanks).EntireRow, [E:AI]).ClearContents
    On Error GoTo 0
End Sub
Чем шире угол зрения, тем он тупее.
 
 
 
#4
17.10.2017 12:28:55
Цитата
tolstak написал:
А еще лучше так:
Спасибо, так код работает гораздо быстрее
 
 
 
#5
17.10.2017 14:04:36
Теперь использую код #tolstak, работает очень быстро
Код
Dim i&, clearRn As Range
    For i = 9 To 208 Step 1
        If Cells(i, 1).Value = 0 Then
' Добавление выбранных ячеек к диапазону
            If clearRn Is Nothing Then
                Set clearRn = Range("E" & i & ":AI" & i)
            Else
                Set clearRn = Union(clearRn, Range("E" & i & ":AI" & i))
            End If
             
        End If
    Next i
' Очистка не каждого диапазона по отдельности, а скопом
    clearRn.ClearContents
End Sub
И возникла необходимость обрабатывать 30 диапазонов по 200 строк на одном листе, например 9-208, 210-409, 411-610 и так далее, как правильно это реализовать?
Изменено: web-master - 17.10.2017 14:05:33
 
 
 
#6
17.10.2017 18:03:59
Цитата
web-master написал:....411-610 и так далее....
Если это 'и так далее' не до бесконечности, то....по мотивам макроса от tolstak,
Код
Sub Ala_Tolstak()
Dim myRng As Range
Dim j&, i&, clearRn As Range
Set myRng = Range("E9:AI208, E210:AI409, E411:AI610, E612:AI811")   'и так далее
For j = 1 To myRng.Areas.Count
fRow = myRng.Areas(j).Row
eRow = myRng.Areas(j).Row + myRng.Areas(j).Rows.Count - 1
    For i = fRow To eRow
        If Cells(i, 1).Value = 0 Then
            'Добавление выбранных ячеек к диапазону
            If Not clearRn Is Nothing Then
                Set clearRn = Union(clearRn, Range("E" & i & ":AI" & i))
            Else
                Set clearRn = Range("E" & i & ":AI" & i)
            End If
              
        End If
    Next
Next
'Очистка не каждого диапазона по отдельности, а скопом
clearRn.ClearContents
End Sub
Согласие есть продукт при полном непротивлении сторон
 
 
 
#7
18.10.2017 04:50:12
Все-таки, перед очисткой нужно проверять очищаемый диапазон. Вдруг нулевых ячеек не нашлось...
Код
Sub ClearRanges()
    Dim x As Range, y As Range
    For Each x In [A9:A208, A210:A409, A411:A610, A612:A811]
        If x.Value = 0 Then If y Is Nothing Then Set y = x Else Set y = Union(x, y)
    Next
    If Not y Is Nothing Then Intersect(y.EntireRow, [E:AI]).ClearContents
End Sub
Чем шире угол зрения, тем он тупее.
 
 
 
#8
18.10.2017 13:37:07
Спасибо всем большое за помощь, как можно сделать перенос длинной строки диапазона, символ _ не помогает
Код
Set myRng = Sheets("Табель (работники участка)").Range("H9:AL208,H210:AL409,H411:AL610,H612:AL811,H813:AL1012,H1014:AL1213,H1215:AL1414,H1416:AL1615,H1615:AL1816,H1818:AL2017,H2019:AL2218,H2220:AL2419,H2421:AL2620,H2622:AL2821,H2823:AL3022,H3024:AL3223,H3225:AL3424,H3426:AL3625,H3627:AL3826,H3828:AL4027,H4029:AL4228,H4230:AL4429,H4431:AL4630,H4632:AL4831,H4833:AL5032,H5034:AL5233,H5235:AL5434,H5436:AL5635,H5637:AL5836,H5838:AL6037,H6039:AL6238")
Изменено: web-master - 18.10.2017 13:37:15
 
 
 
#9
18.10.2017 13:58:42
Цитата
web-master написал: обрабатывать 30 диапазонов по 200 строк на одном листе
Попробуем вообще уйти от перечисления диапазонов. Проверьте на 'боевых' данных
Код
Sub ClearIfNull()
Dim I&, J&, N&
Dim clearRn As Range
N = 9
With Worksheets("Табель (работники участка)")
For I = 1 To 30     '30 диапазонов
    For J = N To N + 199    'по 200 строк
        If .Cells(J, 1).Value = 0 Then
            If Not clearRn Is Nothing Then
                Set clearRn = Union(clearRn, .Range("E" & J & ":AI" & J))
            Else
                Set clearRn = .Range("E" & J & ":AI" & J)
            End If
        End If
    Next
    N = N + 201
Next
If Not clearRn Is Nothing Then clearRn.ClearContents
End With
End Sub
Согласие есть продукт при полном непротивлении сторон
 
 
 
#10
18.10.2017 14:08:18
Sanja, сейчас проверю, есть условие, эти диапазоны (по 200 строк) разделены одной строкой, которую трогать нельзя
 
 
 
#11
18.10.2017 14:17:31
Sanja, спасибо огромное, все работает
 
 
 
Страницы: 1
Наверх