Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
VBA поиск значения по двум критериям и вывод поиска, поиск с использованием VBA
 
Добрый день, в вложении написана формула в "E2:G4", она полностью устраивает за исключением того что придется ее протягивать вправо на 4500 столбов и вниз на 5000 строк
Можно ли эту проблему решить написанием макроса в замен формулы =ЕСЛИОШИБКА(ИНДЕКС(Sheet1!$D:$D;ПОИСКПОЗ(Лист2!$D2&Лист2!E$1;Sheet1!$I:$I&Sheet1!$M:$M;0);1);"")
VBA замена всех совпадений, по не полному совпадению, Replace all
 
Добрый день!
В примере на листе 3 в строке 2:2 нужно заменить текст согласно списка с листа 2 D4 на E4.
предел написания кода тоже в файле имеется.
Заранее благодарен
Изменено: vikttur - 18.10.2021 19:58:14
VBA анализ ячейки на нестабильное изменение
 
Добрый день, ни как не могу решить, прошу помочь.
Есть ячейка "C4" в ней стоит формула
Код
=ЕСЛИ(МИН(C2:C3)<ТДАТА();"";1)

И когда значение становиться = 1 должен запускаться код analiz
Дело в том, что он должен срабатывать сразу же без задержки.

Код
Sub analiz()

If Range("C4") = 1 Then
Application.EnableEvents = False
 Call smotrim
 Application.EnableEvents = True
 Range("C2") = 0
 End If

End Sub
VBA поиск (при необходимости) не первого, а следующего совпадения
 
Доброе утро! Ребят этот код работает хорошо, НО не всегда нужно именно первое совпадение, бывает так что нужно второе. К примеру в 34 столбце появляется цифра которая будет определять какое совпадение нужно выводить, в случае если 34 столбец пустой то искать и выдававть первое. Я понял что не разберусь в VBA сам поэтому обращаюсь к Вам. Спасибо
Код
Private Sub Worksheet_Change(ByVal Target As Range)

'If Target.Cells.Count > 1 Then Exit Sub
'If IsEmpty(Target) Then Exit Sub
If Not Intersect(Target, Range("P1:P100000")) Is Nothing Then

EE = ActiveCell.Row - 1

If IsEmpty(Cells(EE, 17)) = True Then

R = Cells(EE, 9) & " " & Cells(EE, 10) & " " & Cells(EE, 12) & "х" & Cells(EE, 13) & " - " & Cells(EE, 14) & "х" & Cells(EE, 15) & " марка-" & Cells(EE, 20)
R = LCase(R)
Cells(EE, 53) = R

Dim FoundValue As Range

     With Worksheets("База АоРПИ")
     TT = Cells(EE, 53)
      
       Set FoundValue = .Columns(53).Find(TT, , xlValues, xlWhole)
       If FoundValue Is Nothing Then Exit Sub
       
         .Range(.Cells(FoundValue.Row, 9), .Cells(FoundValue.Row, 22)).Copy Cells(EE, 17)
   
     End With

Else: Exit Sub
End If
End If

End Sub
Удалить размноженное условное форматирование и воссоздать по новой
 
Здравствуйте! Проблема с условными форматированиями они все распростроняются на все строки "А:А" и при этом все равно успевают размножаться.
Можно ли макросом их удалить и воссоздать по новой?
Изменено: Артур Рахматуллин - 16.04.2021 10:36:54
Копирование строк как значения в другую книгу, ошибка при вставке строки
 
Добрый день. у меня не получилось вставить код в другом виде, если кто то покажет то буду благодарен
Проблема одна не могу вставить строку как значения.
Спасибо

Код
Sub stroki2()
    Dim Linia As String, RD As String, i As Long, kol_vo As Long, kol_vo2 As Long, x As Long, r As Long, t As Long
    If Not Range("AB24, AB26") Is Nothing Then
     x = 2
      r = 2
       
        Linia = ThisWorkbook.Sheets("АООК").Range("AB26")
        RD = ThisWorkbook.Sheets("АООК").Range("AB24")
        
        With Workbooks("Накопительная ТК.xlsm").Sheets("Сварка")
            kol_vo = .Cells(Rows.Count, 2).End(xlUp).Row
            For i = 1 To kol_vo
                If .Cells(i, 4) = Linia Then
                    If .Cells(i, 2) = RD Then
                    
                        x = x + 1

                   Rows(i).Copy ThisWorkbook.Sheets("Сварка").Cells(x, 1)
                     
                        
                    End If
                End If
            Next
        End With

    End If
    
    Application.EnableEvents = True 'а тут не помешает
End Sub
Изменено: Артур Рахматуллин - 08.04.2021 18:34:39
Страницы: 1
Наверх