Поместить в серый квадрат кнопку, по нажатии которой, сотрудникам, отработавшим более 3 лет на лист "Результат" будет выведена минимальная зарплата.
Поместить в серый квадрат кнопку, по нажатии которой, сотрудникам, отработавшим более 3 лет на лист "Результат" будет выведена минимальная зарплата.StePler_PAV
Предполагаю что просто кинул задания на несколько форумов - где-нибудь может сделают. И даже не парится поздороваться или сказать спасибо за решение. А может решение даже и не смотрел...
Предполагаю что просто кинул задания на несколько форумов - где-нибудь может сделают. И даже не парится поздороваться или сказать спасибо за решение. А может решение даже и не смотрел...Hugo
Sub Премия_от_3_лет() 'Определяем кто отработал больше 3 лет i = 2 j = 2 k = 5 Do While Sheets("Исходные данные 3").Cells(i, 2) <> "" If Sheets("Исходные данные 3").Cells(i, 2) > 3 Then n = Sheets("Исходные данные 3").Cells(i, 1) Do Until n = Sheets("Исходные данные 1").Cells(j, 4) Sheets("Результат").Cells(k, 1) = Sheets("Исходные данные 1").Cells(j, 1) j = j + 1 Loop
''If n = Sheets("Исходные данные 1").Cells(j, 4) Then '' Sheets("Результат").Cells(k, 4) = Sheets("Исходные данные 1").Cells(j, 1) ' Else ' j = j + 1 ' End If End If i = i + 1 Loop
End Sub
[/vba] [vba][code][/code][/vba]
С алгоритмом хотя бы подскажите Моя наработка!
[vba]
Код
Sub Премия_от_3_лет() 'Определяем кто отработал больше 3 лет i = 2 j = 2 k = 5 Do While Sheets("Исходные данные 3").Cells(i, 2) <> "" If Sheets("Исходные данные 3").Cells(i, 2) > 3 Then n = Sheets("Исходные данные 3").Cells(i, 1) Do Until n = Sheets("Исходные данные 1").Cells(j, 4) Sheets("Результат").Cells(k, 1) = Sheets("Исходные данные 1").Cells(j, 1) j = j + 1 Loop
''If n = Sheets("Исходные данные 1").Cells(j, 4) Then '' Sheets("Результат").Cells(k, 4) = Sheets("Исходные данные 1").Cells(j, 1) ' Else ' j = j + 1 ' End If End If i = i + 1 Loop
Нет. На двух словарях. Но можете представить это как два листа - сперва на один записываем всех кто отработал сколько нужно (достаточно только номер), затем на другой записываем тех, кто есть (номером) на первом, с подразделением. Затем второй дополняем всем остальным (месяцем и зарплатой), если есть что дополнять, с проверкой суммы на минимальность. Ну и в итоге переписываем собранное на итоговый лист. Из словаря. Но в принципе можно использовать и листы, как я сейчас понял - наличие и позицию можно проверять функциями листа
Нет. На двух словарях. Но можете представить это как два листа - сперва на один записываем всех кто отработал сколько нужно (достаточно только номер), затем на другой записываем тех, кто есть (номером) на первом, с подразделением. Затем второй дополняем всем остальным (месяцем и зарплатой), если есть что дополнять, с проверкой суммы на минимальность. Ну и в итоге переписываем собранное на итоговый лист. Из словаря. Но в принципе можно использовать и листы, как я сейчас понял - наличие и позицию можно проверять функциями листа Hugo
Если словари не знаете (как и я), то можно вот так [vba]
Код
Sub Кнопка1_Щелчок() 'Определяем кто отработал больше 3 лет i = 2 j = 2 k = 4 Dim arr_(1 To 6)
Do While Sheets("Исходные данные 3").Cells(i, 2) <> "" If Sheets("Исходные данные 3").Cells(i, 2) > 3 Then l = Sheets("Исходные данные 3").Cells(i, 2) n = Sheets("Исходные данные 3").Cells(i, 1) With Sheets("Исходные данные 1") Set nom = .Range("D2:D272").Find(what:=n, lookat:=xlWhole) If Not nom Is Nothing Then arr_(1) = WorksheetFunction.Trim(.Cells(nom.Row, 1) & " " & .Cells(nom.Row, 2) & " " & .Cells(nom.Row, 3)) arr_(2) = n arr_(3) = .Cells(nom.Row, 5) arr_(4) = l End If End With Min_zp = 99 ^ 99 With Sheets("Исходные данные 2").Range("A2:A272") Set c = .Find(what:=arr_(1), lookat:=xlWhole) If Not c Is Nothing Then firstAddress = c.Address Do If c.Offset(0, 2) < Min_zp Then Min_zp = c.Offset(0, 2) mes = c.Offset(0, 1) End If Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> firstAddress End If arr_(5) = mes arr_(6) = Min_zp End With Sheets("Результат").Cells(k, 1).Resize(1, 6) = arr_ k = k + 1 End If i = i + 1 Loop
End Sub
[/vba]
Если словари не знаете (как и я), то можно вот так [vba]
Код
Sub Кнопка1_Щелчок() 'Определяем кто отработал больше 3 лет i = 2 j = 2 k = 4 Dim arr_(1 To 6)
Do While Sheets("Исходные данные 3").Cells(i, 2) <> "" If Sheets("Исходные данные 3").Cells(i, 2) > 3 Then l = Sheets("Исходные данные 3").Cells(i, 2) n = Sheets("Исходные данные 3").Cells(i, 1) With Sheets("Исходные данные 1") Set nom = .Range("D2:D272").Find(what:=n, lookat:=xlWhole) If Not nom Is Nothing Then arr_(1) = WorksheetFunction.Trim(.Cells(nom.Row, 1) & " " & .Cells(nom.Row, 2) & " " & .Cells(nom.Row, 3)) arr_(2) = n arr_(3) = .Cells(nom.Row, 5) arr_(4) = l End If End With Min_zp = 99 ^ 99 With Sheets("Исходные данные 2").Range("A2:A272") Set c = .Find(what:=arr_(1), lookat:=xlWhole) If Not c Is Nothing Then firstAddress = c.Address Do If c.Offset(0, 2) < Min_zp Then Min_zp = c.Offset(0, 2) mes = c.Offset(0, 1) End If Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> firstAddress End If arr_(5) = mes arr_(6) = Min_zp End With Sheets("Результат").Cells(k, 1).Resize(1, 6) = arr_ k = k + 1 End If i = i + 1 Loop