تغییر سطر به ستون با vba

[Cookie]

با سلام

سوالی رو در قسمت پرسش و پاسخ مطرح کردم.
دوستان گفتند که با vba میشه انجامش داد.

جدولی دارم که در ستون ها سال و روز قرار گرفته و در سطر اسامی ماه ها.(فایل پیوست)
در حال حاضر سال و روز در ستون هستند و ماه در سطر ... مثلا روز اول سال 135152 فقط در ماه خرداد مقدار داره ولی در روز دوم همون سال در ماه های فروردین و اسفند داده داره.

می خوام اسامی ماه ها رو هم در ستون ها داشته باشم، یعنی گزارش گیری به این صورت باشه که هم سال هم ماه و هم روز در ستون ها قرار بگیرند و مقدار هم روبه روشون باشه. ولی برای انجام این کار جدول به کلی تغییر خواهد کرد.(چون اسامی ماه ها و روزها و سال ها تکرار بیشتری پیدا می کنند.)

میشه دوستی لطف کنه و کدی بنویسیه که این کار رو انجام بده؟

اخطار: این یک موضوع قدیمی است به دلیل قدیمی بودن موضوع، ممکن است برخی فایل های ضمیمه به درستی کار نکنند. لطفا در صورت عدم ضرورت، از بالا آوردن موضوعات قدیمی خودداری نمایید.

[rahi_feri]

سلام
کد زیر رو در یک Module کپی و اجرا کنید!

چک کنید اطلاع بدید!

Sub hey_you()
Application.ScreenUpdating = False
Dim N As Integer

ActiveWorkbook.Sheets.Add after:=Sheets(Sheets.Count)
N = Sheets.Count
cnt = 1
For i = 2 To Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
    For m = 3 To 14
        If Application.WorksheetFunction.Count(Sheets(1).Range("C" & i & ":N" & i)) = 0 Then
            Sheets(N).Range("A" & cnt).Value = Sheets(1).Cells(i, 1)
            Sheets(N).Range("B" & cnt).Value = Sheets(1).Cells(i, 2)
            cnt = cnt + 1
        ElseIf Sheets(1).Cells(i, m) <> "" Then
            Sheets(N).Range("A" & cnt).Value = Sheets(1).Cells(i, 1)
            Sheets(N).Range("B" & cnt).Value = Sheets(1).Cells(i, 2)
            Sheets(N).Range("C" & cnt).Value = Sheets(1).Cells(i, m)
            Sheets(N).Range("D" & cnt).Value = Sheets(1).Cells(1, m)
            cnt = cnt + 1
        End If
    Next m
Next

Application.ScreenUpdating = True

End Sub

[Cookie]

سلام
کد زیر رو در یک Module کپی و اجرا کنید!

چک کنید اطلاع بدید!

Sub hey_you()
Application.ScreenUpdating = False
Dim N As Integer

ActiveWorkbook.Sheets.Add after:=Sheets(Sheets.Count)
N = Sheets.Count
cnt = 1
For i = 2 To Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
    For m = 3 To 14
        If Application.WorksheetFunction.Count(Sheets(1).Range("C" & i & ":N" & i)) = 0 Then
            Sheets(N).Range("A" & cnt).Value = Sheets(1).Cells(i, 1)
            Sheets(N).Range("B" & cnt).Value = Sheets(1).Cells(i, 2)
            cnt = cnt + 1
        ElseIf Sheets(1).Cells(i, m) <> "" Then
            Sheets(N).Range("A" & cnt).Value = Sheets(1).Cells(i, 1)
            Sheets(N).Range("B" & cnt).Value = Sheets(1).Cells(i, 2)
            Sheets(N).Range("C" & cnt).Value = Sheets(1).Cells(i, m)
            Sheets(N).Range("D" & cnt).Value = Sheets(1).Cells(1, m)
            cnt = cnt + 1
        End If
    Next m
Next

Application.ScreenUpdating = True

End Sub

سلام ..
عالیییی، دقیقا همون که میخواستم ..
خیلی خیلی ممنون ..🌹🌹🌹