Страницы: 1
RSS
Заполнение и замена текста в ячеек по условиям
 
Всем добрый день, уважаемые знатоки!
прошу по возможности помочь макросом или "послать" :) по нужному пути.
есть таблица с исходными данными, которые добавляются ежедневно(пример вложен).
1) Из диапазона E:E найти все ячейки содержащие *Т3 рост* и заменить полностью на Т3 рост (перечислять все нет возможности, они меняются, неизменное только Т3 рост(в начале, середине, конце).
2) Из столбца G:G найти все ячейки содержащие Yes и заменить полностью на Commit
3) Если в строке ячейка L с отрицательным значением, то в ячейке G значение заменить на Commit (даже если ранее стояло No, Basic)
4) В листе Исходные данные (диапазон F:F)  найти значение в листе Список менеджеров (диапазон A:A) и вставить данные из соседней ячейки Б в столбец А (листа Исходные данные)- а-ля ВПР
 
ctrl+H
найти *Т3 рост*
заменить Т3 рост
 
большое спасибо, именно этим сейчас и занимаюсь каждый день:)  
Изменено: Wendflower - 07.06.2019 11:58:28
 
запишите макрорекордером весь процесс и запускайте макрос каждый день. :)
Изменено: V - 06.06.2019 15:05:40
 
Код
Sub Макрос1()
With Sheets("Список менеджеров")
    Lr = .Cells(Rows.Count, 2).End(xlUp).Row
    Set sd = CreateObject("Scripting.Dictionary")
    For i = 2 To Lr
        sd.Item(.Cells(i, 1)) = .Cells(i, 2)
    Next
End With
Lr = Cells(Rows.Count, 2).End(xlUp).Row
'Lr = 13
Range("E2:E" & Lr).Replace What:="*Т3 рост*", Replacement:="Т3 рос", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
Range("G2:G" & Lr).Replace What:="*Yes*", Replacement:="Commit", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
For i = 2 To Lr
    If Cells(i, "L") < 0 Then Cells(i, "G") = "Commit"
    'Cells(i, 1) = sd.Item(Cells(i, "F")) ' не хочет выводить.
Next
End Sub

только не пойму почему не выводит из словаря. Спецы может подправят.
 
Wendflower, Вариант
Код
Sub csg()
    Dim a, b, c, LR As Long, i As Long, ii As Long
    With Sheets(1)
        LR = .Cells(Rows.Count, 6).End(xlUp).Row
        a = Range(.[f2], .Range("F" & LR)).Value
    End With
    With Sheets(2)
        LR = .Cells(Rows.Count, 1).End(xlUp).Row
        b = Range(.[b2], .Range("A" & LR)).Value
    End With
    ReDim c(1 To UBound(a), 1 To 2)
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(b)
            .Item(b(i, 1)) = i
        Next
        For i = 1 To UBound(a)
            If .exists(a(i, 1)) Then
                c(i, 1) = b(.Item(a(i, 1)), 2)
            End If
        Next
    End With
    With Sheets(1)
        .[A2].Resize(UBound(c), 1) = c
        .Activate
    End With
Range("E:E").Replace What:="*Т3 рост*", Replacement:="Т3 рост"
Range("G:G").Replace What:="Yes", Replacement:="Commit"
LR = Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To LR
   If Cells(i, 12) < 0 Then
     Cells(i, 7) = "Commit"
   End If
Next
End Sub

Изменено: casag - 06.06.2019 17:23:59
 
Всем огромное спасибо!!!
Страницы: 1
Наверх