Страницы: 1
RSS
Узнать дату первого и последнего обращения и построить сводную
 
Здравствуйте, уважаемые специалисты!
Дано:файл с номерами телефонов и датами обращения.
Вопрос: как отобразить для каждого телефона первую и последнюю дату?
Спасибо за внимание и ваши ответы!
 
Цитата
как отобразить для каждого телефона первую и последнюю дату?
 Макрос
выделяете уникальные номера телефонов
цикл по этим номерам
Для каждого номера поиск сверху диапазона для первой даты
для последней даты поиск снизу диапазона
 
просто сводная, и там дважды дата , минимальное  и максимальное.
По вопросам из тем форума, личку не читаю.
 
Здесь данные передаются  с 0 значением http://prntscr.com/11lb2ci
Я что то делаю не так?
 
Вот, взгляните, так устроит?
 
Богдан Звирко, почти все все как доктор- Kuzmich, прописал
Код
Sub mrshkei()
Dim arr, arr2, i As Long, n As Long, lr As Long, col As New Collection
lr = Cells(Rows.Count, 6).End(xlUp).Row
arr = Range("F2:I" & lr)
For i = LBound(arr) To UBound(arr)
    If arr(i, 4) <> Empty Then
        On Error Resume Next
        col.Add arr(i, 4), CStr(arr(i, 4))
    End If
Next i
ReDim arr2(0 To UBound(arr) + 1, 1 To 3)
arr2(0, 1) = "Телефон": arr2(0, 2) = "МинДАТА": arr2(0, 3) = "МаксДАТА"
For i = 1 To col.Count
MMax = Application.WorksheetFunction.Min(Columns(6))
MMin = Application.WorksheetFunction.Max(Columns(6))
    For n = LBound(arr) To UBound(arr)
        If col(i) = arr(n, 4) Then
            If MMax < arr(n, 1) Then MMax = arr(n, 1)
            If MMin > arr(n, 1) Then MMin = arr(n, 1)
        End If
    Next n
    arr2(i, 1) = col(i): arr2(i, 2) = MMin: arr2(i, 3) = MMax
Next i
Range("O2").Resize(UBound(arr2) + 1, 3) = arr2
End Sub
Не бойтесь совершенства. Вам его не достичь.
 
Цитата
Богдан Звирко написал:
Я что то делаю не так?
показываете картинку вместо ссылки на файл, у вас там точно даты, а не текст?

пы.сы. тема по гуглу - её бы в курилку
Изменено: buchlotnik - 18.04.2021 09:42:56
Соблюдение правил форума не освобождает от модераторского произвола
 
Шаблон от Hugo с 4 словарями и как альтернатива - 1 словарь с подмассивом...)
Изменено: Marat Ta - 18.04.2021 10:35:16
 
Цитата
Marat Ta написал:
Шаблон от Hugo с 4 словарями
Marat Ta, как вы это собрались приматывать к гугловской таблице?
Соблюдение правил форума не освобождает от модераторского произвола
 
buchlotnik, не понял вашего вопроса и чтобы вы зря не тратили свое время на разборки - файл ТС и макрос от Hugo....
Изменено: Marat Ta - 18.04.2021 11:39:27
 
Цитата
Marat Ta написал:
не понял вашего вопроса
сообщения #4 и #7 - у ТС-а гугл-таблица
Соблюдение правил форума не освобождает от модераторского произвола
 
Ребята, а как приплюсовать к дате время, если время в виде мар.40 или янв.24 ?
 
Kuzmich,
Код
=ВРЕМЯ(МЕСЯЦ(G11);ОСТАТ(ГОД(G11);100);0)
Изменено: buchlotnik - 18.04.2021 12:45:55
Соблюдение правил форума не освобождает от модераторского произвола
 
buchlotnik,
При написании времени 20.19 формула дает #ЗНАЧ!
 
Kuzmich, как часто говорит модератор этого форума "Один вопрос - Одна тема".
Изменено: Marat Ta - 18.04.2021 13:11:50
 
Marat Ta,
Вот пусть модератор это и говорит.
А вопрос относится к этой теме, если даты первого и последнего обращения равны, то надо сравнивать по времени.
 
Время в файле ТС выставлено с заранее продуманной путаницей в форматах и значениях (визуально бросается в глаза)
И корректно не вытащите, т.к. в части ячеек его попросту нет.

Думаю, лучше дождаться ТС в теме.
Изменено: Marat Ta - 18.04.2021 13:25:27
 
Нужно изменить пример в #1. Портить исходные данные в столбце G (см. #4) вовсе не обязательно.
Изменено: sokol92 - 18.04.2021 13:36:54
Владимир
 
Без учета времени
Код
Sub iTelefonDate()
Dim i As Long
Dim iLastRow As Long
 iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
   Range("K1:M" & iLastRow).Clear
   Range("I1:I" & iLastRow).AdvancedFilter xlFilterCopy, CopyToRange:=Range("K1"), Unique:=True
   For i = 2 To Cells(Rows.Count, "K").End(xlUp).Row
     If Cells(i, "K") <> "" Then
       Cells(i, "L") = Range("I1:I" & iLastRow).Find(Cells(i, "K"), , xlValues, xlWhole).Offset(, -3)
       Cells(i, "M") = Range("I1:I" & iLastRow).Find(Cells(i, "K"), Range("I1"), xlValues, xlWhole, xlByRows, xlPrevious).Offset(, -3)
     End If
   Next
     Range("L1:M" & iLastRow).NumberFormat = "dd.mm.yyyy"
End Sub
 
На самом деле, задача несложная (идеально подходит для пособия по изучению VBA) и имеет несколько решений.

Оптимально и просто - это создать сводную таблицу  - из 3 сообщения темы.
Изменено: Marat Ta - 18.04.2021 13:40:55
 
Цитата
Kuzmich написал:
При написании времени 20.19 формула дает #ЗНАЧ!
закономерно - это не дата
Соблюдение правил форума не освобождает от модераторского произвола
 
Цитата
buchlotnik написал:
закономерно - это не дата
А зачем вообще использовать это поле, если вопрос прямо поставлен только про дату?
Вариант
Цитата
Богдан Звирко написал:
как отобразить для каждого телефона первую и последнюю дату?
 
Цитата
Андрей VG написал:
если вопрос прямо поставлен только про дату?
Цитата
Kuzmich написал:
как приплюсовать к дате время, если время в виде мар.40 или янв.24 ?
Соблюдение правил форума не освобождает от модераторского произвола
 
Я имел в виду ситуацию, если даты первого и последнего обращения равны, то надо сравнивать по времени.
 
Решение со словарем. В столбце Р, где две даты, то было два обращения
Код
Sub test()
Dim arr
Dim dic As Object
Dim i As Long
Dim iLastRow As Long
    iLastRow = Cells(Rows.Count, "I").End(xlUp).Row
     Range("O1:P" & iLastRow).ClearContents
     Set dic = CreateObject("Scripting.Dictionary"): dic.comparemode = 1
     arr = Range("F2:I" & iLastRow).Value
  For i = 1 To UBound(arr)
    dic.Item(arr(i, 4)) = dic.Item(arr(i, 4)) & arr(i, 1) & ","
  Next i
   Range("O2").Resize(dic.Count, 2) = Application.Transpose(Array(dic.keys, dic.Items))
End Sub
 
Ну по сути, разные подходы решения. )
Смотря что считать первой и последней датой - то что по списку выше и ниже или все-таки минимальную и максимальную.
В данном отсортированном по дате списке все варианты правильные.
Изменено: Marat Ta - 18.04.2021 19:47:01
Страницы: 1
Наверх