Есть файл, в котором сотни фамилий и меняющиеся цифры относящиеся к этим ФИО (ФИО- постоянные величины), периодически надо отправлять отчет в котором нужно удалять строки относящиеся к конкретной фамилии(созданные структуры-группировки) Вопрос: как подготовить макрос, в котором можно было бы указав фамилии, удалять всю группировку относящуюся к ним ? Во вложенном файле, например, удалить "петров петр петрович" и "астафьев гаврила петрович" (выделено желтым цветом). Фамилии в основном повторяющиеся(90% от общего списка)
Есть файл, в котором сотни фамилий и меняющиеся цифры относящиеся к этим ФИО (ФИО- постоянные величины), периодически надо отправлять отчет в котором нужно удалять строки относящиеся к конкретной фамилии(созданные структуры-группировки) Вопрос: как подготовить макрос, в котором можно было бы указав фамилии, удалять всю группировку относящуюся к ним ? Во вложенном файле, например, удалить "петров петр петрович" и "астафьев гаврила петрович" (выделено желтым цветом). Фамилии в основном повторяющиеся(90% от общего списка)sportsmen
Sub mac() Dim i As Long, lastUsedRow As Long FIO = InputBox("Введите ФИО ", "ФИО") ' вводим нужное ФИО lastUsedRow = Sheets("Лист1").Cells(Sheets("Лист1").Rows.Count, 1).End(xlUp).Row 'номер последн. заполн. строки For i = 2 To lastUsedRow If Cells(i, 1) = FIO And TypeName(Cells(i + 1, 1).Value) <> "String" Then ' удаляем строки под ФИО Rows(i + 1).Delete Shift:=xlUp i = i - 1 lastUsedRow = lastUsedRow - 1 ElseIf Cells(i, 1) = FIO And TypeName(Cells(i + 1, 1).Value) = "String" Then ' удаляем само ФИО Rows(i).Delete Shift:=xlUp i = i - 1 lastUsedRow = lastUsedRow - 1 End If Next End Sub
[/vba]
sportsmen, [vba]
Код
Sub mac() Dim i As Long, lastUsedRow As Long FIO = InputBox("Введите ФИО ", "ФИО") ' вводим нужное ФИО lastUsedRow = Sheets("Лист1").Cells(Sheets("Лист1").Rows.Count, 1).End(xlUp).Row 'номер последн. заполн. строки For i = 2 To lastUsedRow If Cells(i, 1) = FIO And TypeName(Cells(i + 1, 1).Value) <> "String" Then ' удаляем строки под ФИО Rows(i + 1).Delete Shift:=xlUp i = i - 1 lastUsedRow = lastUsedRow - 1 ElseIf Cells(i, 1) = FIO And TypeName(Cells(i + 1, 1).Value) = "String" Then ' удаляем само ФИО Rows(i).Delete Shift:=xlUp i = i - 1 lastUsedRow = lastUsedRow - 1 End If Next End Sub
Матраскин, спасибо, но как включить в макрос сразу, постоянно повторяющиеся фамилии ? (удобнее будет и новые там же прописывать, без диалогового окна)
Матраскин, спасибо, но как включить в макрос сразу, постоянно повторяющиеся фамилии ? (удобнее будет и новые там же прописывать, без диалогового окна)sportsmen
Sub mac() Dim i As Long, lastUsedRow As Long Dim sizeArray As Integer Dim Array_FIO As Variant Array_FIO = Array("петров петр петрович", "григорьева ана петровна") lastUsedRow = Sheets("Лист1").Cells(Sheets("Лист1").Rows.Count, 1).End(xlUp).Row 'номер последн. заполн. строки sizeArray = UBound(Array_FIO) - LBound(Array_FIO) ' размер массива ФИО For j = 0 To sizeArray For i = 2 To lastUsedRow If Cells(i, 1) = Array_FIO(j) And TypeName(Cells(i + 1, 1).Value) <> "String" Then ' удаляем строки под ФИО Rows(i + 1).Delete Shift:=xlUp i = i - 1 lastUsedRow = lastUsedRow - 1 ElseIf Cells(i, 1) = Array_FIO(j) And TypeName(Cells(i + 1, 1).Value) = "String" Then ' удаляем само ФИО Rows(i).Delete Shift:=xlUp i = i - 1 lastUsedRow = lastUsedRow - 1 End If Next Next End Sub
[/vba]
sportsmen, [vba]
Код
Sub mac() Dim i As Long, lastUsedRow As Long Dim sizeArray As Integer Dim Array_FIO As Variant Array_FIO = Array("петров петр петрович", "григорьева ана петровна") lastUsedRow = Sheets("Лист1").Cells(Sheets("Лист1").Rows.Count, 1).End(xlUp).Row 'номер последн. заполн. строки sizeArray = UBound(Array_FIO) - LBound(Array_FIO) ' размер массива ФИО For j = 0 To sizeArray For i = 2 To lastUsedRow If Cells(i, 1) = Array_FIO(j) And TypeName(Cells(i + 1, 1).Value) <> "String" Then ' удаляем строки под ФИО Rows(i + 1).Delete Shift:=xlUp i = i - 1 lastUsedRow = lastUsedRow - 1 ElseIf Cells(i, 1) = Array_FIO(j) And TypeName(Cells(i + 1, 1).Value) = "String" Then ' удаляем само ФИО Rows(i).Delete Shift:=xlUp i = i - 1 lastUsedRow = lastUsedRow - 1 End If Next Next End Sub
Sub mac() Dim i As Long, lastUsedRow As Long Dim sizeArray As Integer Dim Array_FIO As Variant Array_FIO = Array("петров петр петрович", "астафьев гаврила петрович") lastUsedRow = Sheets("Лист1").Cells(Sheets("Лист1").Rows.Count, 1).End(xlUp).Row 'номер последн. заполн. строки sizeArray = UBound(Array_FIO) - LBound(Array_FIO) ' размер массива ФИО For j = 0 To sizeArray For i = 2 To lastUsedRow If Cells(i, 1) = Array_FIO(j) And (TypeName(Cells(i + 1, 1).Value) <> "String" Or _ LCase(Cells(i + 1, 1).Value) Like "на период*") Then ' удаляем строки под ФИО Rows(i + 1).Delete Shift:=xlUp i = i - 1 lastUsedRow = lastUsedRow - 1 ElseIf Cells(i, 1) = Array_FIO(j) And TypeName(Cells(i + 1, 1).Value) = "String" Then ' удаляем само ФИО Rows(i).Delete Shift:=xlUp i = i - 1 lastUsedRow = lastUsedRow - 1 End If Next Next End Sub
[/vba]
sportsmen, новые и новые приключения) [vba]
Код
Sub mac() Dim i As Long, lastUsedRow As Long Dim sizeArray As Integer Dim Array_FIO As Variant Array_FIO = Array("петров петр петрович", "астафьев гаврила петрович") lastUsedRow = Sheets("Лист1").Cells(Sheets("Лист1").Rows.Count, 1).End(xlUp).Row 'номер последн. заполн. строки sizeArray = UBound(Array_FIO) - LBound(Array_FIO) ' размер массива ФИО For j = 0 To sizeArray For i = 2 To lastUsedRow If Cells(i, 1) = Array_FIO(j) And (TypeName(Cells(i + 1, 1).Value) <> "String" Or _ LCase(Cells(i + 1, 1).Value) Like "на период*") Then ' удаляем строки под ФИО Rows(i + 1).Delete Shift:=xlUp i = i - 1 lastUsedRow = lastUsedRow - 1 ElseIf Cells(i, 1) = Array_FIO(j) And TypeName(Cells(i + 1, 1).Value) = "String" Then ' удаляем само ФИО Rows(i).Delete Shift:=xlUp i = i - 1 lastUsedRow = lastUsedRow - 1 End If Next Next End Sub