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

Вход

Регистрация

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

 

= Мир MS Excel/Удалить опр-ное кол-во строк - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Удалить опр-ное кол-во строк (Макросы/Sub)
Удалить опр-ное кол-во строк
iliyhabrest Дата: Воскресенье, 22.08.2021, 16:55 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

1
На ЛИСТ0 удалить строки со значением ЛИСТ1-СтолбецB в кол-ве ЛИСТ1-(5-СтолбецC) пример на скриншоте, так же в Лист1-СтолбецВ могут не быть числа которые есть в Лист0-СтолбецА, в этом случае оставлять 5 чисел
К сообщению приложен файл: 6946357.png(5.5 Kb)


Сообщение отредактировал iliyhabrest - Воскресенье, 22.08.2021, 17:15
 
Ответить
СообщениеНа ЛИСТ0 удалить строки со значением ЛИСТ1-СтолбецB в кол-ве ЛИСТ1-(5-СтолбецC) пример на скриншоте, так же в Лист1-СтолбецВ могут не быть числа которые есть в Лист0-СтолбецА, в этом случае оставлять 5 чисел

Автор - iliyhabrest
Дата добавления - 22.08.2021 в 16:55
RAN Дата: Воскресенье, 22.08.2021, 17:29 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 5496
Репутация: 1100 ±
Замечаний: 0% ±

2010
В файл png ни формулы, ни макросы вставляться не желают. Вот печалька.

PS Илья Попов [ Женщина ]
Чи голубой, чи розовый?


Быть или не быть, вот в чем загвоздка!

Сообщение отредактировал RAN - Воскресенье, 22.08.2021, 17:32
 
Ответить
СообщениеВ файл png ни формулы, ни макросы вставляться не желают. Вот печалька.

PS Илья Попов [ Женщина ]
Чи голубой, чи розовый?

Автор - RAN
Дата добавления - 22.08.2021 в 17:29
iliyhabrest Дата: Воскресенье, 22.08.2021, 17:43 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

1
RAN,
К сообщению приложен файл: 111.xlsx(11.0 Kb)
 
Ответить
СообщениеRAN,

Автор - iliyhabrest
Дата добавления - 22.08.2021 в 17:43
RAN Дата: Понедельник, 23.08.2021, 10:44 | Сообщение № 4
Группа: Друзья
Ранг: Участник клуба
Сообщений: 5496
Репутация: 1100 ±
Замечаний: 0% ±

2010
[vba]
Код
Sub qq()
    Dim tmp(), ar, i&, x&, k&, j&, oDic As Object, ark
    ar = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)).Value
    Set oDic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(ar)
        If Not oDic.exists(ar(i, 1)) Then
            oDic.Item(ar(i, 1)) = 5
            x = x + 5
        End If
    Next
    ar = Range(Cells(2, 2), Cells(Rows.Count, 3).End(xlUp)).Value
    For i = 1 To UBound(ar)
        If oDic.exists(ar(i, 1)) Then
            oDic.Item(ar(i, 1)) = 5 - ar(i, 2)
            If oDic.Item(ar(i, 1)) = 0 Then oDic.Remove (ar(i, 1))
            x = x - ar(i, 2)
        End If
    Next
    ReDim tmp(1 To x, 1 To 1)
    ark = oDic.keys
    For i = 1 To UBound(tmp)
        If j = 0 Then
            j = oDic.Item(ark(k))
        End If
        If j > 0 Then
            tmp(i, 1) = ark(k)
            j = j - 1
        End If
        If j = 0 Then k = k + 1
    Next
    [f2].Resize(UBound(tmp)).Value = tmp
End Sub
[/vba]


Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение[vba]
Код
Sub qq()
    Dim tmp(), ar, i&, x&, k&, j&, oDic As Object, ark
    ar = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)).Value
    Set oDic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(ar)
        If Not oDic.exists(ar(i, 1)) Then
            oDic.Item(ar(i, 1)) = 5
            x = x + 5
        End If
    Next
    ar = Range(Cells(2, 2), Cells(Rows.Count, 3).End(xlUp)).Value
    For i = 1 To UBound(ar)
        If oDic.exists(ar(i, 1)) Then
            oDic.Item(ar(i, 1)) = 5 - ar(i, 2)
            If oDic.Item(ar(i, 1)) = 0 Then oDic.Remove (ar(i, 1))
            x = x - ar(i, 2)
        End If
    Next
    ReDim tmp(1 To x, 1 To 1)
    ark = oDic.keys
    For i = 1 To UBound(tmp)
        If j = 0 Then
            j = oDic.Item(ark(k))
        End If
        If j > 0 Then
            tmp(i, 1) = ark(k)
            j = j - 1
        End If
        If j = 0 Then k = k + 1
    Next
    [f2].Resize(UBound(tmp)).Value = tmp
End Sub
[/vba]

Автор - RAN
Дата добавления - 23.08.2021 в 10:44
iliyhabrest Дата: Понедельник, 23.08.2021, 11:01 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

1
RAN, Спасибо большое :up:
 
Ответить
СообщениеRAN, Спасибо большое :up:

Автор - iliyhabrest
Дата добавления - 23.08.2021 в 11:01
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Удалить опр-ное кол-во строк (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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