سلام من یه حلقه نوشتم تا حدودی کارمو میکنه خیلی تلاش کردم بلد نیستم ولی تا یه جاهایی نوشتم خوب کار میکنه بقیش موندم چکار کنم کسی میتونه کمکم کنه فایل بفرستم یا کد رو برام اصلاح کنه؟
حلقه تو در تو
Collapse
این تاپیک قفل است.
X
X
-
-
سلام این فایل همراه با کدی که نوشتم ببینید درسته کد اجرا کنید شاید متوجه شدید چی میخوامفایل های پیوست شدهکامنت
-
توضیح بدید خواسته شما از این ماکرو چی هستش ؟ چه عملیاتی رو انجام میده
در فایل پیوست شیت Report را بررسی بفرماییدفایل های پیوست شدهLast edited by iranweld; 2019/03/16, 09:37.کامنت
-
فایل های پیوست شدهکامنت
-
با سلام
فایل پیوست را بررسی کنید.
بعد از اتمام ماکرو عناوین سر ستون ها و سطر ماه را بصورت دستی اضافه کنید
کد PHP:Sub Macro2()
Sheets("k").Cells.ClearContents
Application.ScreenUpdating = False
T = 1
Sheets("e").Select
z1 = Sheets("e").Cells(Sheets("e").Rows.Count, "A").End(xlUp).Row
For i = 3 To z1 Step 16
For j = 3 To 23
k1 = Application.WorksheetFunction.CountA(Sheets("k").Range(T & ":" & T)) + 1
Range(Cells(i, j), Cells(i + 15, j)).Copy
Sheets("k").Cells(T, k1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Next
T = T + 1
Next
Sheets("k").Select
Application.ScreenUpdating = True
End Sub
فایل های پیوست شدهLast edited by iranweld; 2019/03/16, 15:06.کامنت
-
با سلام
فایل پیوست را بررسی کنید.
بعد از اتمام ماکرو عناوین سر ستون ها و سطر ماه را بصورت دستی اضافه کنید
کد PHP:Sub Macro2()
Sheets("k").Cells.ClearContents
Application.ScreenUpdating = False
T = 1
Sheets("e").Select
z1 = Sheets("e").Cells(Sheets("e").Rows.Count, "A").End(xlUp).Row
For i = 3 To z1 Step 16
For j = 3 To 23
k1 = Application.WorksheetFunction.CountA(Sheets("k").Range(T & ":" & T)) + 1
Range(Cells(i, j), Cells(i + 15, j)).Copy
Sheets("k").Cells(T, k1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Next
T = T + 1
Next
Sheets("k").Select
Application.ScreenUpdating = True
End Sub
لطف کردینکامنت
کامنت