Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Ошибка run-time error 1004 в цикле макроса, При прогоне цикла возникает ошибка run-time error 1004
 
#1
02.03.2017 00:02:09
Есть макрос(ниже), ошибка возникает в строке то ли следующей после строки с Do, то ли через одну от нее. Код ошибки: run-time error 1004. Смысл в том чтоб пробегать столбец С, и проверять столбец А, на соответствие значению в столбце С, если есть совпадения красим, если нет бежим дальше. Имя специально не менял ибо название в дальнейшем будет "Страшное".
Код
Sub Макрос6()
'
' Макрос6 Макрос
' stop
'
' Сочетание клавиш: Ctrl+t
'
i = 1
    Range(Selection, Selection.End(xlDown)).Select
    Do While i <= 100
        Selection.FormatConditions.Add Type:=xlTextString, String:="=$C$i", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Loop
End Sub
Изменено: decha - 02.03.2017 00:13:42
 
 
 
#2
02.03.2017 00:13:15
decha, скрипт делает несколько иное от того что вы описали, а именно он не красит при условии, а для выделенной области настраивает условное форматирование, при этом делает это не совсем эффективно , так как создает для каждой ячейки собственное правило, вместо одного правила для области/областей.
1. вы уверены, что вам надо именно то что вы нам показали?
1. Пример файла приложите.
По вопросам из тем форума, личку не читаю.
 
 
 
#3
02.03.2017 00:27:47
Да, я не совсем правильно объяснил, Макрос я записывал. По сути есть колонка с фразами и колонка со словами, надо покрасить в первой колонке все фразы, в которых есть хотя бы одно слово из второй. вот файл. Пытался засунуть все в цикл, чтоб проходить отдельно для каждой строки из столбца, но наткнулся на ошибку, VB- это вам не C++, как говорится.
Изменено: Денис Голуб - 02.03.2017 00:29:36
 
 
 
#4
02.03.2017 00:31:12
Код
Sub СТРАШНОЕ()
Dim Cl As Range
lRow = Cells(Rows.Count, 3).End(xlUp).Row
For Each Cl In Range("C1:C" & lRow).Cells
    If Cl.Offset(, -2) Like "*" & Cl & "*" Then
        Cl.Font.Color = -16383844
        Cl.Interior.Color = 13551615
    End If
Next
End Sub
Изменено: Sanja - 02.03.2017 00:32:46
Согласие есть продукт при полном непротивлении сторон
 
 
 
#5
02.03.2017 00:38:57
Странно, попробовал использовать, но выделилось только слово сбербанк и то в колонке С,  а надо в А
 
 
 
#6
02.03.2017 00:46:44
Код
Sub СТРАШНОЕ()
Dim arrA, arrC
Dim I&, J&
arrA = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value
arrC = Range("C1:C" & Cells(Rows.Count, 3).End(xlUp).Row).Value
For I = 1 To UBound(arrA)
    For J = 1 To UBound(arrC)
        If arrA(I, 1) Like "*" & arrC(J, 1) & "*" Then
            With Cells(I, 1)
                .Font.Color = -16383844
                .Interior.Color = 13551615
            End With
        End If
    Next
Next
End Sub
Изменено: Sanja - 02.03.2017 01:24:45
Согласие есть продукт при полном непротивлении сторон
 
 
 
#7
02.03.2017 01:07:33
Еще вариант
Код
Sub СТРАШНОЕ()
Dim arrA, arrC
Dim I&, J&
Dim colRange As Range
arrA = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value
arrC = Range("C1:C" & Cells(Rows.Count, 3).End(xlUp).Row).Value
With CreateObject("Scripting.Dictionary")
    For I = 1 To UBound(arrA)
        For J = 1 To UBound(arrC)
            If arrA(I, 1) Like "*" & arrC(J, 1) & "*" Then
                tempVal = .Item(I)
                If Not colRange Is Nothing Then
                    Set colRange = Union(colRange, Cells(I, 1))
                Else
                    Set colRange = Cells(I, 1)
                End If
            End If
        Next
    Next
End With
With colRange
    .Font.Color = -16383844
    .Interior.Color = 13551615
End With
End Sub
Изменено: Sanja - 02.03.2017 01:13:30
Согласие есть продукт при полном непротивлении сторон
 
 
 
#8
02.03.2017 09:23:56
Цитата
Денис Голуб написал:
VB- это вам не C++, как говорится.
даже в там, исходя из первого примера вы б зациклили до бесконечности
Код
i = 1
    Range(Selection, Selection.End(xlDown)).Select
    Do While i <= 100
Но это уже не важно ибо пришел Sanja и все по своему сделал ;-)

А нужен ли был скрипт?
По вопросам из тем форума, личку не читаю.
 
 
 
#9
02.03.2017 09:53:57
Можно и формулой, но она может потеряться, забыться или сам случайно сотрешь. А макрос можно кинуть, в отдельный файлик, текстовый и при случае юзать. Но все равно спасибо.
Всем спасибо, проблему решили.
 
 
 
Страницы: 1
Наверх