Что тут изменить надо???

Весь MS Office, программирование на Visual Basic for Applications и MS VB

Модератор: Naeel Maqsudov

Ответить
Александра Нехорошев
Сообщения: 2
Зарегистрирован: 20 июн 2013, 15:45

В первых 10 столбцах рабочего листа находятся сведения о сотрудниках фирмы. Причем в первых трех столбцах рабочего листа записаны: фамилия, имя и отчество. Необходимо написать программу, делающую выборку сотрудников: телефон начинается с трех цифр 962, а зарплата превышает среднее значение зарплаты всех сотрудников. Имена полей и их содержимое придумать самостоятельно. Полученную выборку вывести на второй рабочий лист.


Type Spisok
lastName As String
firstName As String
papaName As String
age As Integer
End Type

Sub лаба7()
Dim sp() As Spisok, i As Integer, j As Integer, n As Integer

Sheets("Лист2").Select
Range("a2:j10").Clear
Sheets("Лист1").Select
While (Cells(n + 1, 1) <> "")
n = n + 1
Wend
n = n - 1
ReDim sp(n)

For i = 1 To n
sp(i).lastName = Cells(i + 1, 1)
sp(i).firstName = Cells(i + 1, 2)
sp(i).papaName = Cells(i + 1, 3)
sp(i).age = Cells(i + 1, 4)
Next i

sp = sortByLastName(sp, n, True)
sp = sortByAge(sp, n, True)

j = 2
For i = 1 To n
Sheets("Лист2").Select
Cells(j, 1) = sp(i).lastName
Cells(j, 2) = sp(i).firstName
Cells(j, 3) = sp(i).papaName
Cells(j, 4) = sp(i).age
j = j + 1
Next i
End Sub

Private Function sortByLastName(massive() As Spisok, massiveSize As Integer, key As Boolean) As Spisok()
' key = true - по возрастанию
' key = false - по убыванию
Dim sI As Integer, sJ As Integer, buf As Spisok

For sI = 1 To massiveSize - 1
For sJ = 1 To massiveSize - sI
If (key) Then
If (massive(sJ).lastName > massive(sJ + 1).lastName) Then
buf = massive(sJ)
massive(sJ) = massive(sJ + 1)
massive(sJ + 1) = buf
End If
Else
If (massive(sJ).lastName < massive(sJ + 1).lastName) Then
buf = massive(sJ)
massive(sJ) = massive(sJ + 1)
massive(sJ + 1) = buf
End If
End If
Next sJ
Next sI

sortByLastName = massive
End Function

Private Function sortByAge(massive() As Spisok, massiveSize As Integer, key As Boolean) As Spisok()
' key = true - по возрастанию
' key = false - по убыванию
Dim sI As Integer, sJ As Integer, buf As Spisok

For sI = 1 To massiveSize - 1
For sJ = 1 To massiveSize - sI
If (key) Then
If (massive(sJ).age > massive(sJ + 1).age) Then
buf = massive(sJ)
massive(sJ) = massive(sJ + 1)
massive(sJ + 1) = buf
End If
Else
If (massive(sJ).age < massive(sJ + 1).age) Then
buf = massive(sJ)
massive(sJ) = massive(sJ + 1)
massive(sJ + 1) = buf
End If
End If
Next sJ
Next sI

sortByAge = massive
End Function
Hugo121
Сообщения: 13
Зарегистрирован: 14 авг 2013, 21:34

Брр...
Ставите фильтр, записываете действо в макрос. Программа готова.
А да, сперва высчитываете среднюю зарплату - можно формулой, можно кодом, можно совместить (формулой на листе, считываем значение кодом, используем в фильтре).
Ответить