Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Критерии по листам - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Критерии по листам
Nika4880 Дата: Среда, 14.12.2022, 16:17 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 12
Репутация: 0 ±
Замечаний: 40% ±

2017
Добрый день, коллеги.
Необходимо разделить один лист по критериям с помощью VBA по отдельным листам, который в столбце K в документе.
По номерам счетов. Так можно сделать?
Помогите, пожалуйста.
К сообщению приложен файл: 9362470.xlsx (12.6 Kb)


Сообщение отредактировал Nika4880 - Среда, 14.12.2022, 17:09
 
Ответить
СообщениеДобрый день, коллеги.
Необходимо разделить один лист по критериям с помощью VBA по отдельным листам, который в столбце K в документе.
По номерам счетов. Так можно сделать?
Помогите, пожалуйста.

Автор - Nika4880
Дата добавления - 14.12.2022 в 16:17
msi2102 Дата: Среда, 14.12.2022, 19:03 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 415
Репутация: 129 ±
Замечаний: 0% ±

Excel 2007
Попробуйте так:
[vba]
Код
Sub Макрос1()
Set dic = CreateObject("Scripting.Dictionary")
arr = Sheets("data_2022-12-14_16-06-43").ListObjects("Таблица1").ListColumns("Номер выставленного нами счета, счет-фактуры, даты выставления").DataBodyRange
Application.DisplayAlerts = False
For n = 1 To UBound(arr)
    If Not dic.Exists(arr(n, 1)) Then
        dic.Add arr(n, 1), arr(n, 1)
        Sheets("data_2022-12-14_16-06-43").Copy Before:=Sheets(1)
        ActiveSheet.Name = Replace(arr(n, 1), ".", "_")
        With ActiveSheet.ListObjects([a7].ListObject.Name)
            .Range.AutoFilter Field:=11, Criteria1:="<>" & arr(n, 1), Operator:=xlOr
            .DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
            .Range.AutoFilter Field:=11
        End With
    End If
Next
Application.DisplayAlerts = True
End Sub
[/vba]
К сообщению приложен файл: 9362470.xlsm (25.5 Kb)
 
Ответить
СообщениеПопробуйте так:
[vba]
Код
Sub Макрос1()
Set dic = CreateObject("Scripting.Dictionary")
arr = Sheets("data_2022-12-14_16-06-43").ListObjects("Таблица1").ListColumns("Номер выставленного нами счета, счет-фактуры, даты выставления").DataBodyRange
Application.DisplayAlerts = False
For n = 1 To UBound(arr)
    If Not dic.Exists(arr(n, 1)) Then
        dic.Add arr(n, 1), arr(n, 1)
        Sheets("data_2022-12-14_16-06-43").Copy Before:=Sheets(1)
        ActiveSheet.Name = Replace(arr(n, 1), ".", "_")
        With ActiveSheet.ListObjects([a7].ListObject.Name)
            .Range.AutoFilter Field:=11, Criteria1:="<>" & arr(n, 1), Operator:=xlOr
            .DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
            .Range.AutoFilter Field:=11
        End With
    End If
Next
Application.DisplayAlerts = True
End Sub
[/vba]

Автор - msi2102
Дата добавления - 14.12.2022 в 19:03
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!