Страницы: 1
RSS
Поиск и вывод всех дат заказов по номеру позиции товара
 
Доброе утро)
Как мне вставить в последний лист все даты заказов  по наименованию товара и найти последнюю дату (лист 3 выделено жёлтым).
Может кто-нибудь сталкивался с моей или схожей проблемой?
Кто может подскажет какую функцию мне использовать?
Извиняюсь за наименования товара после 10 строчки, мой файл очень большой и сюда не влазет, поэтому сделала пример.
 
 
снегурка, Добрый день...название темы общее вам бы конкретно написать(:
Цитата
снегурка написал:
вставить в последний лист все даты заказов  по наименованию товара и найти последнюю дату
но поменять у вас уже не выйдет предложите в тексте письма а модератор придет и поменяет) и решение быстрее получите...

даты могут повторятся для одного и того \же товара?
Не бойтесь совершенства. Вам его не достичь.
 
Да!Даты могут повторяться)
 
Цитата
снегурка написал:
Даты могут повторяться
а что насчет названия темы? Вы поймите, пока не предложите нормальное отвечать смысла нет - тему удалят или закроют. В лучшем случае скрою все ответы с решениями. Оно кому надо?
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Код
Sub Main()
    Dim x As Integer
    Dim y As Long
    Dim a As Variant
    Dim m As Long
    With Sheets("Заказы")
        y = .Cells(.Rows.Count, 1).End(xlUp).Row
        x = .UsedRange.Columns.Count
        a = .Range(.Cells(1, 1), .Cells(y, x))
        m = WorksheetFunction.Max(.Range("C3:XFD1048576"))
    End With
    If m < 1 Then Exit Sub
    
    Dim d As Object
    Set d = CreateObject("Scripting.Dictionary")
    For y = 3 To UBound(a, 1)
        For x = 3 To UBound(a, 2)
            If Not d.Exists(a(y, x)) Then Set d.Item(a(y, x)) = CreateObject("Scripting.Dictionary")
            If Not IsEmpty(a(y, x)) Then
                d.Item(a(y, x)).Item(a(y, 1)) = 0
            End If
        Next
    Next
    
    Dim b As Variant
    ReDim b(1 To m + 1, 1 To UBound(a, 1))
    Dim v As Variant
    Dim w As Variant
    For Each v In d.keys
        x = 2
        m = 0
        For Each w In d.Item(v).keys
            b(v, x) = w
            If m < w Then m = w
            x = x + 1
        Next
        If m > 0 Then b(v, 1) = m
    Next
    
    With Sheets("Лист3")
        .Range("C3").Resize(UBound(b, 1), UBound(b, 2)) = b
    End With
End Sub
Ээээээ.... пока писал, выяснилось, что название темы под вопросом.
Изменено: МатросНаЗебре - 19.02.2020 10:01:17
 
а как вставить макрос в ексель?
 
Alt+F11
Правой кнопкой, например, на ЭтаКнига.
Insert - Module
В появившееся окно вставить текст с форума. Не со всего, а с одного сообщения )
 
снегурка, Название темы:  Поиск и вывод всех дат заказов по номеру  позиции товара.

и еще вариант
Код
Sub dati()
Dim i As Double, k As Double, n As Double
Dim ilastrow As Integer, ilastrow2 As Integer, ilastcol As Integer, ilastcol2 As Integer
Application.ScreenUpdating = False

Worksheets("Лист3").Cells(3, 3).Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
    
ilastrow = Worksheets("Лист3").Cells(Rows.Count, 1).End(xlUp).Row
For n = 3 To ilastrow Step 1
    ilastrow2 = Worksheets("Заказы").Cells(Rows.Count, 1).End(xlUp).Row
    For i = 3 To ilastrow2 Step 1
        ilastcol = Worksheets("Заказы").Cells(i, Columns.Count).End(xlToLeft).Column
        For k = 3 To ilastcol Step 1
        ilastcol2 = Worksheets("Лист3").Cells(n, Columns.Count).End(xlToLeft).Column + 1
        If ilastcol2 = 3 Then
        ilastcol2 = ilastcol2 + 1
        Else
        ilastcol2 = ilastcol2
        End If
        If Worksheets("Заказы").Cells(i, k) = Worksheets("Лист3").Cells(n, 1) Then
        Worksheets("Лист3").Cells(n, ilastcol2) = Worksheets("Заказы").Cells(i, 1)
        End If
        Next k
    Next i
        If WorksheetFunction.Count(Range(Cells(n, 4), Cells(n, ilastcol2))) > 0 Then
        Worksheets("Лист3").Cells(n, 3) = WorksheetFunction.Max(Range(Cells(n, 4), Cells(n, ilastcol2)))
        Else
        Worksheets("Лист3").Cells(n, 3) = ""
        End If
Next n
Application.ScreenUpdating = True

End Sub
Изменено: Mershik - 19.02.2020 12:20:59
Не бойтесь совершенства. Вам его не достичь.
 
Спасибо большое всем)  
 
Я скопировала в свой файл и год у меня вместо 2020 появился 1900??
Где я могла ошибиться?
 
Подозреваю, что 1900 это 0. Если дат в строке нет, то выводит 0.
 
проверила формат даты стоит в ячейке где дата!
 
А Вы какой код используете, из сообщения #5 или #8?
 
8
 
А если из #5.
 
снегурка, покажите лучше пример с ошибкой
Не бойтесь совершенства. Вам его не достичь.
 
прикрепила
 
снегурка, ну у вас же отличаются таблицы ...вас это не смутило?
Не бойтесь совершенства. Вам его не достичь.
 
я думала главное количество строк и столбцов а также листы и их названия(
 
снегурка,
ниже под второй пример, но обратите внимание что у вас не даты на листе "Worksheet", а текст, соответсвенно не будет максимальаня дата проставляться вв листе 3 для того что бы считалась максимальная - приведите даты в порядок можно так: написать число 1 в любой ячейке и скопировать ее - затем выделить ячейки с датами - специальная вставка - умножить и тогда все будет работать....
Код
Sub dati()
Dim i As Double, k As Double, n As Double
Dim ilastrow As Integer, ilastrow2 As Integer, ilastcol As Integer, ilastcol2 As Integer
Application.ScreenUpdating = False
 
Worksheets("Лист3").Cells(3, 2).Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
     
ilastrow = Worksheets("Лист3").Cells(Rows.Count, 1).End(xlUp).Row
For n = 2 To ilastrow Step 1
    ilastrow2 = Worksheets("Worksheet").Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To ilastrow2 Step 1
        ilastcol = Worksheets("Worksheet").Cells(i, Columns.Count).End(xlToLeft).Column
        For k = 3 To ilastcol Step 1
        ilastcol2 = Worksheets("Лист3").Cells(n, Columns.Count).End(xlToLeft).Column + 1
        If ilastcol2 = 2 Then
        ilastcol2 = ilastcol2 + 1
        Else
        ilastcol2 = ilastcol2
        End If
        If Worksheets("Worksheet").Cells(i, k) = Worksheets("Лист3").Cells(n, 1) Then
        Worksheets("Лист3").Cells(n, ilastcol2) = Worksheets("Worksheet").Cells(i, 2)
        End If
        Next k
    Next i
        If WorksheetFunction.Count(Range(Cells(n, 3), Cells(n, ilastcol2))) > 0 Then
        Worksheets("Лист3").Cells(n, 2) = WorksheetFunction.Max(Range(Cells(n, 3), Cells(n, ilastcol2)))
        Else
        Worksheets("Лист3").Cells(n, 2) = ""
        End If
Next n
Application.ScreenUpdating = True
 
End Sub
Не бойтесь совершенства. Вам его не достичь.
 
Mershik
Спасибо Вам большое! все работает)))
Страницы: 1
Наверх