Простое перечисление по датам с нумерацией строк

[бетон]

Добрый день!
Уважаемые программисты, если возможно в Экселе 2007 с помощью формулы создать список в три столбца из таблицы 500х1500, то очень прошу помочь.
Взываю к сообществу после бесплодных самостоятельных попыток!!!

[Igor1961]

В реальности в исходной таблице присутствуют все 365 дней на каждый год (строка 3 в файле) ?

[Serge_Bliznykov]

Сообщение от бетон

с помощью формулы создать список в три столбца из таблицы 500х1500

это наверняка можно сделать формулами.
Но я бы лично решал такую задачу через макрос на VBA

[сфинкс]

наверное в разделе "Нужный результат"

столбец C со списком событий лишний

тогда "Нужный результат" превращается в простую таблицу

повёрнутую на 90 градусов относительно таблицы исходной

кажись нужна команда =ТРАНСП
необычно вставляемая читайте справку

и я применил =ТРАНСП в таблице ниже

[бетон]

Уважаемый Сфинкс!
Именно столбец С нужен. Вся соль в нем и заключается - в перечислении произошедших событий в конкретный день.
Нумерация - либо событий, либо дней, в зависимости от варианта, нужна для ориентирования по таблице результата.

[бетон]

Добрый день!
Serge_Bliznykov, прошу решить эту задачу если не формулой, то макросом. Очень!

[Aleksandr H.]

пилите под себя

Sub goMfucker()
    Dim sh1 As Worksheet
    Dim sh As Worksheet
    Dim firstRow As Integer
    Dim lastRow As Integer
    Dim lastCol As Integer
    Dim iCol As Integer
    Dim iRow As Integer
    Dim iiRow As Integer
    Dim i As Integer
    Dim firstEvent As Boolean
        Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableCancelKey = xlDisabled
    Set sh1 = Sheets(1)
    Set sh = Sheets(2)
    With sh1
        firstRow = 4
        lastRow = 29
        lastCol = 14
        sh.Cells.ClearContents
        .Range("A" & firstRow & ":A" & lastRow).Copy
        sh.Range("D1").PasteSpecial Transpose:=True
        iiRow = 2
        For iCol = 2 To lastCol
            firstEvent = True
            For iRow = firstRow To lastRow
                If .Cells(iRow, iCol).Value <> vbNullString Then
                    i = iRow - firstRow + 4
                    If firstEvent Then
                        sh.Cells(iiRow, "B") = .Cells(firstRow - 1, iCol)
                        firstEvent = False
                    End If
                    sh.Cells(iiRow, "C") = sh.Cells(iiRow, "C").Value & .Cells(iRow, "A").Value & vbNewLine
                    sh.Cells(iiRow, i) = .Cells(iRow, iCol).Value
                    sh.Cells(iiRow, "A") = iiRow - 1
                End If
            Next iRow
            If Not firstEvent Then iiRow = iiRow + 1
        Next iCol
     End With
    Set sh1 = Nothing
    Set sh = Nothing
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "DONE!"
End Sub

[бетон]

Aleksandr H.,
спасибо за ответ!
Возникли вопросы:
Буквально ли понимать goMfucker
1. Можно ли получить результат на новом листе с названием, например, "отчет"
2. Почему нет строки с порядковым номером 2
3. Можно ли получить результат с форматом "дата" для столбца В
4. Можно ли получить результат с перечислением событий в столбце С через запятую с пробелом
5. Можно ли получить результат с динамическими свойствами

[бетон]

добавляю результат

[Aleksandr H.]

Сообщение от бетон

1. Можно ли получить результат на новом листе с названием, например, "отчет"
2. Почему нет строки с порядковым номером 2
3. Можно ли получить результат с форматом "дата" для столбца В
4. Можно ли получить результат с перечислением событий в столбце С через запятую с пробелом
5. Можно ли получить результат с динамическими свойствами

1. Да
2. Не знаю
3. Да
4. Да
5. Что такое "динамическое свойство"? Читайте о UsedRange

Option Explicit

Sub goMfucker()
    Dim sh1 As Worksheet
    Dim sh As Worksheet
    Dim firstRow As Integer
    Dim lastRow As Integer
    Dim lastCol As Integer
    Dim iCol As Integer
    Dim iRow As Integer
    Dim iiRow As Integer
    Dim i As Integer
    Dim firstEvent As Boolean
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableCancelKey = xlDisabled
    Set sh1 = Sheets(1)
    Set sh = Sheets("Отчет")
    With sh1
        firstRow = 4
        lastRow = 29
        lastCol = 14
        sh.Cells.ClearContents
        .Range("A" & firstRow & ":A" & lastRow).Copy
        sh.Range("D1").PasteSpecial Transpose:=True
        sh.Columns("B:B").NumberFormat = "dd.mm.yyyy;@"
        iiRow = 2
        For iCol = 2 To lastCol
            firstEvent = True
            For iRow = firstRow To lastRow
                If .Cells(iRow, iCol).Value <> vbNullString Then
                    i = iRow - firstRow + 4
                    If firstEvent Then
                        sh.Cells(iiRow, "B") = .Cells(firstRow - 1, iCol)
                        firstEvent = False
                    End If
                    sh.Cells(iiRow, "C") = sh.Cells(iiRow, "C").Value & .Cells(iRow, "A").Value & ", " & vbNewLine
                    sh.Cells(iiRow, i) = .Cells(iRow, iCol).Value
                    sh.Cells(iiRow, "A") = iiRow - 1
                End If
            Next iRow
            If Not firstEvent Then
                sh.Cells(iiRow, "C") = Left(sh.Cells(iiRow, "C").Value2, Len(sh.Cells(iiRow, "C").Value2) - 4)
                iiRow = iiRow + 1
            End If
        Next iCol
    End With
    Set sh1 = Nothing
    Set sh = Nothing
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "DONE!"
End Sub