Найти максимум в строках при совпадении условия по всем столбцам

@alexpro555 · Регистрация: 26.09.2016

Студворк — интернет-сервис помощи студентам

Здравствуйте

есть задача реализованная в виде формулы, но появился нюанс, надо будет наращивать файл данными(увеличивать кол-во столбцов, строк) , а человек(началник) который будет заполнять этот файл владеет экселом очень плохо.
и возникла необходимость реализовать эту задачу макросом чтобы потом привязать к кнопке, т.е. нажав на кнопку ,первый столбец сам проставился.

суть задачи:
Необходимо найти максимальную дату(ДатаЗаменыАКБ) в строке по всем столбцам и вставить её в самый первый столбец(ЗаменаАКБ)
при отсутствии даты подставляло бы какое то значение, к примеру "нет даты", что будет являться критерием о забытом техниками устройстве.
Пояснение: Эта дата будет являться плановой для планирования Закупок.

Вкладываю пример____И Б П v 1 5____.7z

Заранее благодарен

@Narimanych · 26.09.2016, 15:16

alexpro555,
Вы забыли снять пароль....

@alexpro555 · 27.09.2016, 08:37 **[ТС]**

пароль:1

@KoGG · 27.09.2016, 15:54

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub Дата_замены_АКБ()
    Dim i&, j&, LastRow&, LastColumn&, A, MaxDate As Date
    LastRow = Cells(Rows.Count, 2).End(xlUp).Row
    LastColumn = ActiveSheet.UsedRange.Columns.Count
    A = Range([A1], Cells(LastRow, LastColumn)).Value
    Range("A3:A" & LastRow).Interior.Pattern = xlNone
    For i = 3 To LastRow
        MaxDate = 0
        For j = 10 To LastColumn Step 5
            If IsDate(A(i, j)) Then
                If MaxDate < A(i, j) Then MaxDate = A(i, j)
            End If
        Next j
        If MaxDate > 0 Then
            Cells(i, 1) = DateAdd("yyyy", 3, MaxDate)
        Else
            Cells(i, 1) = "нет даты"
            Cells(i, 1).Interior.color = 13551615
        End If
    Next i
End Sub

@alexpro555 · 28.09.2016, 15:15 **[ТС]**

то что доктор прописал
отработало с пол оборота с первого раза за четверть секунды и всё верно
забыл написать про приплюсовать 3 года , но вы и сами догадались.
респект и уважуха
теперь не страшно этот файл в неумелые руки отдавать для заполнения и расчёта фин.-плана

Добавлено через 9 минут
спасибо

Добавлено через 1 час 31 минуту

Сообщение от KoGG

For j = 10 To LastColumn Step 5

можно ли эту часть заменить на поиск по "Дата Замены АКБ", дело в том что нет гарантий что пользователь куда ни будь не вставит не нужный столбец и собьёт всю красоту расчёта.

@KoGG · 28.09.2016, 16:02

Можно

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Дата_замены_АКБ()
    Dim i&, j&, LastRow&, LastColumn&, A, MaxDate As Date
    LastRow = Cells(Rows.Count, 2).End(xlUp).Row
    LastColumn = ActiveSheet.UsedRange.Columns.Count
    A = Range([A1], Cells(LastRow, LastColumn)).Value
    Range("A3:A" & LastRow).Interior.Pattern = xlNone
    For i = 3 To LastRow
        MaxDate = 0
        For j = 10 To LastColumn
            If StrComp(Trim(A(2, j)), "Дата Замены АКБ", vbTextCompare) = 0 Then
                If IsDate(A(i, j)) Then
                    If MaxDate < A(i, j) Then MaxDate = A(i, j)
                End If
            End If
        Next j
        If MaxDate > 0 Then
            Cells(i, 1) = DateAdd("yyyy", 3, MaxDate)
        Else
            Cells(i, 1) = "нет даты"
            Cells(i, 1).Interior.color = 13551615
        End If
    Next i
End Sub

@alexpro555 · 29.09.2016, 10:25 **[ТС]**

супер
чудеса просто
теперь можно косячить в файле и не задумываться о формулах

Добавлено через 1 час 18 минут
а вот эта часть кода

Сообщение от KoGG

For j = 10 To LastColumn

видимо если заменить на жёсткую привязку то будет примерно что-то вроде этого?:

Visual Basic
1
2
3
4
Range("B1").Select
    Cells.Find(What:="Дата Замены АКБ", After:=ActiveCell, LookIn:=xlFormulas _
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate

@KoGG · 29.09.2016, 10:53

Сообщение от alexpro555

примерно что-то вроде этого

Примерно да, но не более того.

@alexpro555 · 29.09.2016, 11:06 **[ТС]**

Так?:

Visual Basic
1
2
3
4
5
s = Range("B1").Select , Cells.Find(What:= Дата Замены АКБ, After:=ActiveCell, LookIn:=xlFormulas _
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        
        For j = s To LastColumn

@KoGG · 29.09.2016, 12:02

Не так точно, без кавычек Дата Замены АКБ писать нельзя.
Примерно в том смысле, что никаких Select , никаких Activate и в цикле с Cells.Find своя специфика выхода из цикла.

Добавлено через 13 минут
На случай изменения строки начала шапки, если так нравится Find

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Sub Дата_замены_АКБ()
    Dim i&, j&, LastRow&, LastColumn&, A, MaxDate As Date, FoundRng As Range, firstAddress$
    LastRow = Cells(Rows.Count, 2).End(xlUp).Row
    LastColumn = ActiveSheet.UsedRange.Columns.Count
    A = Range([A1], Cells(LastRow, LastColumn)).Value
    Range("A3:A" & LastRow).Interior.Pattern = xlNone
    For i = 3 To LastRow
        MaxDate = 0
        Set FoundRng = Cells.Find(What:="Дата Замены АКБ", LookIn:=xlFormulas, LookAt:=xlPart, MatchCase:=False)
        If Not FoundRng Is Nothing Then
            firstAddress = FoundRng.Address
            Do
                j = FoundRng.Column
                If IsDate(A(i, j)) Then
                    If MaxDate < A(i, j) Then MaxDate = A(i, j)
                End If
                Set FoundRng = Cells.FindNext(FoundRng)
                If FoundRng Is Nothing Then Exit Do
            Loop While FoundRng.Address <> firstAddress
        End If
        If MaxDate > 0 Then
            Cells(i, 1) = DateAdd("yyyy", 3, MaxDate)
        Else
            Cells(i, 1) = "нет даты"
            Cells(i, 1).Interior.color = 13551615
        End If
    Next i
End Sub

Но Find медленне.

@alexpro555 · 29.09.2016, 15:39 **[ТС]**

да чуть-чуть помедленнее , но надёжно как в "танке"
пробовал намеренно испортить данные но не получается, всё равно рассчитывает верно.

СПАСИБО!

@KoGG · 29.09.2016, 15:56

Оптимальнее:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub Дата_замены_АКБ()
    Dim i&, j&, LastRow&, LastColumn&, A, MaxDate As Date, FoundRng As Range, firstAddress$, Col&()
    LastRow = Cells(Rows.Count, 2).End(xlUp).Row
    LastColumn = ActiveSheet.UsedRange.Columns.Count
    A = Range([A1], Cells(LastRow, LastColumn)).Value
    Range("A3:A" & LastRow).Interior.Pattern = xlNone
    Set FoundRng = Cells.Find(What:="Дата Замены АКБ", LookIn:=xlFormulas, LookAt:=xlPart, MatchCase:=False)
    If Not FoundRng Is Nothing Then
        firstAddress = FoundRng.Address
        Do
            i = i + 1
            ReDim Preserve Col(i)
            Col(i) = FoundRng.Column
            Set FoundRng = Cells.FindNext(FoundRng)
            If FoundRng Is Nothing Then Exit Do
        Loop While FoundRng.Address <> firstAddress
        For i = 3 To LastRow
            MaxDate = 0
            For j = 1 To UBound(Col)
                If IsDate(A(i, Col(j))) Then
                    If MaxDate < A(i, Col(j)) Then MaxDate = A(i, Col(j))
                End If
            Next j
            If MaxDate > 0 Then
                Cells(i, 1) = DateAdd("yyyy", 3, MaxDate)
            Else
                Cells(i, 1) = "нет даты"
                Cells(i, 1).Interior.color = 13551615
            End If
        Next i
    End If
End Sub

@alexpro555 · 10.02.2017, 10:22 **[ТС]**

Здравствуйте

Возникла необходимость расширить возможности расчётов этого файла с макросами
нужна ваша помощь

появилась новая кнопка "реальная дата оставшегося срока работы аккумулятора" в формах VBA
я начал корректировать но находит максимальное значение а не минимальное, но потом выяснилось что минимальных значений со временем будет много, а значит что нужно найти последнее значение в строке, т.е. крайнее правое в строке по "столбцу "состояние АКБ"
В расчёте будут использованы последние два столбца "состояние АКБ" с данными в строке, датаТО этих состояний АКБ, коэффициент
Пример расчёта приведён в листе "Пример"

Заранее благодарен

@KoGG · 10.02.2017, 11:30

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub Дата_оставшегося_срока_АКБ()
    Dim i&, j&, LastRow&, LastColumn&, A, FoundRng As Range, firstAddress$, Col&()
    Dim Sost#, dSost#, dDateTO#, КоеfС1#
    КоеfС1 = [C1]
    LastRow = Cells(Rows.Count, 2).End(xlUp).Row
    LastColumn = ActiveSheet.UsedRange.Columns.Count
    A = Range([A1], Cells(LastRow, LastColumn)).Value
    Range("A3:A" & LastRow).Interior.Pattern = xlNone
    Set FoundRng = Rows(2).Find(What:="состояние АКБ", SearchOrder:=xlByColumns, LookIn:=xlFormulas, LookAt:=xlPart, MatchCase:=False)
    If Not FoundRng Is Nothing Then
        firstAddress = FoundRng.Address
        Do
            i = i + 1
            ReDim Preserve Col(i)
            Col(i) = FoundRng.Column
            Set FoundRng = Rows(2).FindNext(FoundRng)
            If FoundRng Is Nothing Then Exit Do
        Loop While FoundRng.Address <> firstAddress
        For i = 3 To LastRow
            For j = UBound(Col) To 1 Step -1
                If Trim(A(i, Col(j))) <> "" And Col(j) > 7 Then
                    Sost = A(i, Col(j))
                    dSost = A(i, Col(j - 1)) - Sost
                    If A(i, Col(j - 1)) <> 0 And dSost <> 0 Then
                        dDateTO = A(i, Col(j) - 4) - A(i, Col(j - 1) - 4)
                        Cells(i, 1) = (Sost - КоеfС1) * dDateTO / dSost
                    End If
                    Exit For
                End If
            Next j
        Next i
    End If
End Sub

@alexpro555 · 10.02.2017, 13:40 **[ТС]**

когда я запускаю этот макрос в Лист1 то выдаёт несоответствие типов(type mismatch)
на строке

Visual Basic
1
 dSost = A(i, Col(j - 1)) - Sost

а в листе Пример он отрабатывает нормально но только в одной строке считает

можно сделать чтобы макрос работал в Лист1 и считал в каждой строке

Добавлено через 24 минуты
можно сделать чтобы макрос работал в Лист1 и считал в каждой строке ?
а там где нет данных по столбцу "состояние АКБ" то выдавало бы "нет коэф."

Добавлено через 56 минут

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Sub Дата_оставшегося_срока_АКБ()
    Dim i&, j&, LastRow&, LastColumn&, A, FoundRng As Range, firstAddress$, Col&()
    Dim Sost#, dSost#, dDateTO#, КоеfС1#
    КоеfС1 = [C1]
    LastRow = Cells(Rows.Count, 2).End(xlUp).Row
    LastColumn = ActiveSheet.UsedRange.Columns.Count
    A = Range([A1], Cells(LastRow, LastColumn)).Value
    Range("A3:A" & LastRow).Interior.Pattern = xlNone
    Set FoundRng = Rows(2).Find(What:="состояние АКБ", SearchOrder:=xlByColumns, LookIn:=xlFormulas, LookAt:=xlPart, MatchCase:=False)
    If Not FoundRng Is Nothing Then
        firstAddress = FoundRng.Address
        Do
            i = i + 1
            ReDim Preserve Col(i)
            Col(i) = FoundRng.Column
            Set FoundRng = Rows(2).FindNext(FoundRng)
            If FoundRng Is Nothing Then Exit Do
        Loop While FoundRng.Address <> firstAddress
        For i = 3 To LastRow
            For j = UBound(Col) To 1 Step -1
                If Trim(A(i, Col(j))) <> "" And Col(j) > 7 Then
                    Sost = A(i, Col(j))
                    dSost = A(i, Col(j - 1)) - Sost
                    If A(i, Col(j - 1)) <> 0 And dSost <> 0 Then
                        dDateTO = A(i, Col(j) - 4) - A(i, Col(j - 1) - 4)
                         If dDateTO > 0 Then
                        Cells(i, 1) = (Sost - КоеfС1) * dDateTO / dSost
                        Else
            Cells(i, 1) = "нетКоэф."
            Cells(i, 1).Interior.Color = 13551615
                        End If
                     End If
                    Exit For
                End If
            Next j
        Next i
    End If
End Sub

видимо так?
но проблема в Лист1 , не соображу как обойти если не везде заполнено
может можно добавить там где нет предыдущего ТО то в расчёт не брать и выводить "не все ТО проведены, заполнены"

Добавлено через 18 минут

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
'Sub Дата_оставшегося_срока_АКБ()
    Dim i&, j&, LastRow&, LastColumn&, A, FoundRng As Range, firstAddress$, Col&()
    Dim Sost#, dSost#, dDateTO#, КоеfС1#
    КоеfС1 = [C1]
    LastRow = Cells(Rows.Count, 2).End(xlUp).Row
    LastColumn = ActiveSheet.UsedRange.Columns.Count
    A = Range([A1], Cells(LastRow, LastColumn)).Value
    Range("A3:A" & LastRow).Interior.Pattern = xlNone
    Set FoundRng = Rows(2).Find(What:="состояние АКБ", SearchOrder:=xlByColumns, LookIn:=xlFormulas, LookAt:=xlPart, MatchCase:=False)
    If Not FoundRng Is Nothing Then
        firstAddress = FoundRng.Address
        Do
            i = i + 1
            ReDim Preserve Col(i)
            Col(i) = FoundRng.Column
            Set FoundRng = Rows(2).FindNext(FoundRng)
            If FoundRng Is Nothing Then Exit Do
        Loop While FoundRng.Address <> firstAddress
        For i = 3 To LastRow
            For j = UBound(Col) To 1 Step -1
                If Trim(A(i, Col(j))) <> "" And Col(j) > 7 Then
                    Sost = A(i, Col(j))
                            If Sost > 0 Then
                    dSost = A(i, Col(j - 1)) - Sost
                    If A(i, Col(j - 1)) <> 0 And dSost <> 0 Then
                        dDateTO = A(i, Col(j) - 4) - A(i, Col(j - 1) - 4)
                        If dDateTO > 0 Then
                            Cells(i, 1) = (Sost - КоеfС1) * dDateTO / dSost
                            Else
                            Cells(i, 1) = "нет Даты ТО."
                            Cells(i, 1).Interior.Color = 13551615
                        End If
                            Else
                            Cells(i, 1) = "не все ТО-коэф"
                            End If
                     End If
                    Exit For
                End If
            Next j
        Next i
    End If
End Sub

но всё равно на эту строчку ругается dSost = A(i, Col(j - 1)) - Sost мол не соотв.типов

@KoGG · 10.02.2017, 13:51

Я сделал настройки по листу "пример", чтобы не считалось по строкам, где нет двух не нулевых последних правых значений "состояние АКБ", а так же, когда последнее значение "состояние АКБ" в 7 столбце (то есть это последнее и предыдущего нет).
Исходя из заполненности данных на листе "Пример" и нужно считать только по одной строке 10, в других строках не хватает данных.
Так как шапка Лист1 другая, то в моем последнем макросе строку 21 надо заменить на

Visual Basic
1
If Trim(A(i, Col(j))) <> "" And Col(j) > 10 Then

Если еще считать случай, когда есть последнее значение "состояние АКБ", но нет предпоследнего (лист Пример строка 4)
то строку 24 надо заменить на

Visual Basic
1
If dSost <> 0 Then

однако вычисленное значение по приведенному алгоритму будет равно -121,83

@alexpro555 · 10.02.2017, 15:10 **[ТС]**

да извините что не полностью объяснил
рабочий файл данных находится в Лист1
а в пример я поместил формулу расчёта для Лист1

Добавлено через 1 час 7 минут
Видимо так?

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
'
Sub Дата_оставшегося_срока_АКБ()
        
    Dim i&, j&, LastRow&, LastColumn&, A, FoundRng As Range, firstAddress$, Col&()
    Dim Sost#, dSost#, dDateTO#, ÊîåfÑ1#
    ÊîåfÑ1 = [C1]
    LastRow = Cells(Rows.Count, 2).End(xlUp).Row
    LastColumn = ActiveSheet.UsedRange.Columns.Count
    A = Range([A1], Cells(LastRow, LastColumn)).Value
    Range("A3:A" & LastRow).Interior.Pattern = xlNone
    Set FoundRng = Rows(2).Find(What:="ñîñòîÿíèå ÀÊÁ", SearchOrder:=xlByColumns, LookIn:=xlFormulas, LookAt:=xlPart, MatchCase:=False)
    If Not FoundRng Is Nothing Then
        firstAddress = FoundRng.Address
        Do
            i = i + 1
            ReDim Preserve Col(i)
            Col(i) = FoundRng.Column
            Set FoundRng = Rows(2).FindNext(FoundRng)
            If FoundRng Is Nothing Then Exit Do
        Loop While FoundRng.Address <> firstAddress
        For i = 3 To LastRow
            For j = UBound(Col) To 1 Step -1
                'If Trim(A(i, Col(j))) <> "" And Col(j) > 7 Then
                If Trim(A(i, Col(j))) <> "" And Col(j) > 12 Then
                    Sost = A(i, Col(j))
                            If Sost > 0 Then
                    dSost = A(i, Col(j - 1)) - Sost
                                'If dSost > 0 Then
                    'If A(i, Col(j - 1)) <> 0 And dSost <> 0 Then
                    If dSost <> 0 Then
                        dDateTO = A(i, Col(j) - 4) - A(i, Col(j - 1) - 4)
                                If dDateTO > 0 Then
                                Cells(i, 1) = (Sost - ÊîåfÑ1) * dDateTO / dSost
                                Else
                                Cells(i, 1) = "íåò Äàòû ÒÎ."
                                Cells(i, 1).Interior.Color = 13551615
                                End If
                            Else
                            Cells(i, 1) = "íå âñå ÒÎ-êîýô"
                            End If
                                Else
                                Cells(i, 1) = "íå êîððåê.Êîýô"
                                'End If
                     End If
                    Exit For
                End If
            Next j
        Next i
    End If
End Sub

@alexpro555 · 03.03.2017, 14:57 **[ТС]**

Здравствуйте
я уже на правильном пути?

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
Private Sub CommandButton777_Click()
 
    Columns("A:A").Select
    Selection.NumberFormat = "General"
    Range("B1").Select
    
    Range("a3", Cells(Rows.Count, 1).End(xlDown)).Select
    With Selection.Font
        .ColorIndex = xlAutomatic
       .TintAndShade = 0
    End With
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
     Selection.ClearContents
     Range("B1").Select
    
     Dim i&, j&, LastRow&, LastColumn&, A, FoundRng As Range, firstAddress$, Col&()
    Dim Sost#, dSost#, dDateTO#, КоеfС1#
    'Dim runningVB As Boolean '555
 
    КоеfС1 = [C1]
    LastRow = Cells(Rows.Count, 2).End(xlUp).Row
    LastColumn = ActiveSheet.UsedRange.Columns.Count
    A = Range([A1], Cells(LastRow, LastColumn)).Value
    Range("A3:A" & LastRow).Interior.Pattern = xlNone
    Set FoundRng = Rows(2).Find(What:="состояние АКБ", SearchOrder:=xlByColumns, LookIn:=xlFormulas, LookAt:=xlPart, MatchCase:=False)
    If Not FoundRng Is Nothing Then
        firstAddress = FoundRng.Address
        Do
            i = i + 1
            ReDim Preserve Col(i)
            Col(i) = FoundRng.Column
            Set FoundRng = Rows(2).FindNext(FoundRng)
            If FoundRng Is Nothing Then Exit Do
        Loop While FoundRng.Address <> firstAddress
        For i = 3 To LastRow
            For j = UBound(Col) To 1 Step -1
                If Trim(A(i, Col(j))) <> "" And Col(j) > 10 Then
                    Sost = A(i, Col(j))
                                If Sost = IsEmpty(cell) Or Sost <> IsNumeric(ActiveCell.Value) Or Sost <= 0 Then      '555
                                    Cells(i, 1) = "не верные данные." '555
                                'If Sost = IsNumeric(Cell) Then
                                    'Cells(i, 1) = "не верные данные." '555
                                'If Sost = IsEmpty(ActiveCell) = True Then '555
                                    'Cells(i, 1) = "не верные данные." '555
                                
                                
                                
                                'Else '555
                                    dSost = A(i, Col(j - 1)) - Sost '32 строка
                                    'On Error Resume Next
                                    If dSost <> IsNumeric(cell) Or dSost <= 0 Or dSost = IsEmpty(cell) Then
                                    'If Trim(cell.Value) <> "" Then
                                    Cells(i, 1) = " в ячейке текст"
                                    'On Error GoTo 0 '37
                                    'If A(i, Col(j - 1)) <> 0 Then '555
                                    'If dSost > 0 Then '= CBool(expression) Then '555
                                         'If A(i, Col(j - 1)) <> 0 And dSost <> 0 Then
                                         'If dSost = IsNumeric(ActiveCell) Then '555
                                         'Cells(i, 1) = "не верные данные." '555
                                         If dSost <= 0 Then
                                         'Cells(i, 1) = "не верные данные." '555
                                           ' Else '555
                                        'ElseIf dSost <> 0 Then '555
                                        'Message = "There are " & dSost & " items." '555
 
                                            dDateTO = A(i, Col(j) - 4) - A(i, Col(j - 1) - 4)
                                            'Cells(i, 1) = (Sost - КоеfС1) * dDateTO / dSost
                                            Cells(i, 1) = (A(i, Col(j) - 4)) + ((Sost - КоеfС1) * dDateTO / dSost)
                                            If Cells(i, 1) <= 0 Then  '555
                                            Cells(i, 1) = "не верные данные." '555
                                            
                                            'If IsEmpty(ActiveCell) = True Then '555
                                            'MsgBox "Ячейка пустая"'555
                                            'ActiveCell = "не верные данные." '555
                                            'Cells(i, 1) = "нет Даты коэф." '555
                                            'Cells(i, 1).Interior.Color = 13551615 '555
                                         
                                            'Else '555
                                            'Cells(i, 1) = "нет Даты." '555
                                            'Cells(i, 1).Interior.Color = 13551615 '555
                                End If
                                
                                           ' If IsEmpty(ActiveCell) Then
                                           ' Cells(i, 1) = "не верны данные."
                                'Else '555
                                  'Cells(i, 1) = "нет" '555
                                  'Cells(i, 1).Interior.Color = 13551615 '555
                                              'End If '555
                    Exit For
                    
                     End If
                    End If '555 "не верные данные."
                    'End If '555 "не верные данные."
                     'End If '555 "не верные данные."
                   End If '555 "не верные данные."
                 End If
                 
            Next j
        Next i
    End If
End Sub

Добавлено через 1 час 44 минуты
не пойму как переход делать на след.строку если найдена ошибка не соответсвия данных или не выполнено условие о правильном заполнении данными

@alexpro555 · 24.03.2017, 13:58 **[ТС]**

подскажите пожал. правильно ли я расставил энд ифы? в последней редакции

Новые блоги и статьи Все статьи Все блоги /
Ритм жизни kumehtar 27.02.2026 Иногда приходится жить в ритме, где дел становится всё больше, а вовлечения в происходящее — всё меньше. Плотный график не даёт вниманию закрепиться ни на одном событии. Утро начинается с быстрых,. . .	[В процессе разработки] SDL3 для Web (WebAssembly): Сборка библиотек SDL3 и Box2D из исходников с помощью CMake и Emscripten 8Observer8 27.02.2026 Недавно вышла версия 3. 4. 2 библиотеки SDL3. На странице официальной релиза доступны исходники, готовые DLL (для x86, x64, arm64), а также библиотеки для разработки под Android, MinGW и Visual Studio. . . .	SDL3 для Web (WebAssembly): Реализация движения на Box2D v3 - трение и коллизии с повёрнутыми стенами 8Observer8 20.02.2026 Содержание блога Box2D позволяет легко создать главного героя, который не проходит сквозь стены и перемещается с заданным трением о препятствия, которые можно располагать под углом, как верхнее. . .	Конвертировать закладки radiotray-ng в m3u-плейлист damix 19.02.2026 Это можно сделать скриптом для PowerShell. Использование . \СonvertRadiotrayToM3U. ps1 <path_to_bookmarks. json> Рядом с файлом bookmarks. json появится файл bookmarks. m3u с результатом. # Check if. . .
Семь CDC на одном интерфейсе: 5 U[S]ARTов, 1 CAN и 1 SSI Eddy_Em 18.02.2026 Постепенно допиливаю свою "многоинтерфейсную плату". Выглядит вот так: https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11617&stc=1&d=1771445347 Основана на STM32F303RBT6. На борту пять. . .	Камера Toupcam IUA500KMA Eddy_Em 12.02.2026 Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .	И ясному Солнцу zbw 12.02.2026 И ясному Солнцу, и светлой Луне. В мире покоя нет и люди не могут жить в тишине. А жить им немного лет.	«Знание-Сила» zbw 12.02.2026 «Знание-Сила» «Время-Деньги» «Деньги -Пуля»

@alexpro555 0 / 0 / 0 Регистрация: 26.09.2016 Сообщений: 14

	Excel Найти максимум в строках при совпадении условия по всем столбцам 26.09.2016, 12:07. Показов 1779. Ответов 18 Метки нет (Все метки) Здравствуйте есть задача реализованная в виде формулы, но появился нюанс, надо будет наращивать файл данными(увеличивать кол-во столбцов, строк) , а человек(началник) который будет заполнять этот файл владеет экселом очень плохо. и возникла необходимость реализовать эту задачу макросом чтобы потом привязать к кнопке, т.е. нажав на кнопку ,первый столбец сам проставился. суть задачи: Необходимо найти максимальную дату(ДатаЗаменыАКБ) в строке по всем столбцам и вставить её в самый первый столбец(ЗаменаАКБ) при отсутствии даты подставляло бы какое то значение, к примеру "нет даты", что будет являться критерием о забытом техниками устройстве. Пояснение: Эта дата будет являться плановой для планирования Закупок. Вкладываю пример____И Б П v 1 5____.7z Заранее благодарен 0

@Narimanych 2751 / 1725 / 779 Регистрация: 23.03.2015 Сообщений: 5,449
	26.09.2016, 15:16
	alexpro555, Вы забыли снять пароль.... 1

@alexpro555 0 / 0 / 0 Регистрация: 26.09.2016 Сообщений: 14
	27.09.2016, 08:37 [ТС]
	пароль:1 0

@alexpro555 0 / 0 / 0 Регистрация: 26.09.2016 Сообщений: 14
	29.09.2016, 15:39 [ТС]
	да чуть-чуть помедленнее , но надёжно как в "танке" пробовал намеренно испортить данные но не получается, всё равно рассчитывает верно. СПАСИБО! 0

@alexpro555 0 / 0 / 0 Регистрация: 26.09.2016 Сообщений: 14
	24.03.2017, 13:58 [ТС]
	подскажите пожал. правильно ли я расставил энд ифы? в последней редакции 0

Найти максимум в строках при совпадении условия по всем столбцам

Решение