Страницы: 1
RSS
Отобрать номера заказов из столбца с атрибутом "к" в другом столбце
 
Добрый день. Хотел пойти по пути сводной таблицы, но понял, что не очень подходит.
Нужно отобрать все номера заказов из столбца А с атрибутом "к" в столбце D на странице "Текущий". Вставить эти данные на страницу "Отбор" в столбец D. Но впереди этого списка нужно вставить такие же данные из страницы прошлого года "Пр_год". Буду благодарен за любую помощь.
 
Цитата
Фрезератор написал:
Отобрать данные по значению.
Название слищком общее. Задача в чём заключается? Предложите новое название - модераторы поменяют.
 
Название - Вывести отдельно данные по заданному значению.
Изменено: Фрезератор - 25.01.2021 14:39:04
 
так?  
чтоб дело мастера боялось, он знает много страшных слов.
 
Фрезератор,раз ответ уже есть)(тему не придумывать):
1. недавно такая же тема почти https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=136687&...
2. так же в приемах есть https://www.planetaexcel.ru/techniques/2/81/
3. Макросом см. файл.
Код
Sub mrshkei()
Dim arr, arr2, i As Long, j As Long, lr As Long, sh As Worksheet, sh2 As Worksheet
Set sh = Worksheets("Отбор"): Set sh2 = Worksheets("Текущий")
lr = sh2.Cells(Rows.Count, 1).End(xlUp).Row
arr = sh2.Range("A2:D" & lr)
j = 1
ReDim arr2(1 To Application.WorksheetFunction.CountIf(sh2.Range("D2:D" & lr), "к"), 1 To 2)
For i = LBound(arr) To UBound(arr)
    If arr(i, 4) = "к" Then
        arr2(j, 1) = arr(i, 1)
        arr2(j, 2) = arr(i, 3)
        j = j + 1
    End If
Next i
sh.Range("D7:D" & sh.Cells(Rows.Count, 4).End(xlUp).Row + 1).ClearContents
sh.Range("D7").Resize(UBound(arr2), 2) = arr2
End Sub

Изменено: Mershik - 25.01.2021 15:26:09
Не бойтесь совершенства. Вам его не достичь.
 
Спасибо всем что не оставили без внимания мой вопрос.
Пробую разобраться с макросом. т.к. мне надо в столбец D сначала надо вставить данные прошлого года, а потом текущего.
Изменено: Фрезератор - 26.01.2021 08:29:20
 
Цитата
Фрезератор написал:
сначала надо вставить данные прошлого года, а потом текущего.
Код
Sub mrshkei()
Dim arr, arr2, i As Long, j As Long, lr As Long, sh As Worksheet, sh2 As Worksheet, sh3 As Worksheet, wh As Worksheet
Set sh = Worksheets("Отбор"): Set sh2 = Worksheets("Текущий"): Set sh3 = Worksheets("Пр_год")
sh.Range("D7:E" & sh.Cells(Rows.Count, 4).End(xlUp).Row + 1).ClearContents
j = 1
For Each wh In Worksheets
    If wh.Name = sh2.Name Or wh.Name = sh3.Name Then
        lr = wh.Cells(Rows.Count, 1).End(xlUp).Row
        arr = wh.Range("A2:D" & lr)
        ReDim arr2(1 To Application.WorksheetFunction.CountIf(wh.Range("D2:D" & lr), sh.Cells(5, 5)), 1 To 2)
        
        For i = LBound(arr) To UBound(arr)
            If arr(i, 4) = sh.Cells(5, 5) Then
                arr2(j, 1) = arr(i, 1)
                arr2(j, 2) = arr(i, 3)
                j = j + 1
            End If
        Next i
        sh.Range("D" & sh.Cells(Rows.Count, 4).End(xlUp).Row + 1).Resize(UBound(arr2), 2) = arr2
        j = 1
     End If
Next wh
End Sub
Не бойтесь совершенства. Вам его не достичь.
 
Mershik. Пока пытался вникнуть, слабоват я в VBA. Вы бац (на тебе), спасибо.
В строке №10 ReDim arr2(1 To Application.WorksheetFunction.CountIf(wh.Range("D2:D" & lr), sh.Cells(5, 5)), 1 To 2) пишет индекс вне диапазона.
 
Фрезератор, не правда в приложенном файле в #6 - все работает, в след. раз прикладывайте файл где у вас не работает
Изменено: Mershik - 26.01.2021 10:57:15
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, спасибо. Правда всё работает. Хотелось бы разобраться в принципе работы этой процедуры. Если можно, буду оставлять вопросики в этой теме? На случай полного ступора.
 
Фрезератор, попробуйте, если вопрос будет связан непосредственно с темой, а так не я так кто-то другой ответит возможно
Не бойтесь совершенства. Вам его не достичь.
Страницы: 1
Наверх