کپی اطلاعات شیت 1 به شیت 2 با ترتیب سفارشی

**iranweld** · 2018/12/31, 12:23

با سلام

این کد را تست کنید و موارد مد نظر را اعلام کنید

منظور شما از این چیست؟

در شیت یک ردیف مربوط به کالایی به نام مانیتور با کد 124 خالی وارد شود یعنی اصلا جاش خالی باشه

کد PHP:


Sub test()


z1 = Cells(Rows.Count, "A").End(xlUp).Row
Z2 = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row + 1

Sheet1.Range("A2:D" & z1).Copy Destination:=Sheet2.Range("A" & Z2)

Sheet2.Select


End Sub

فایل های پیوست شده

**sajjadstr** · 2018/12/31, 13:59

نوشته اصلی توسط iranweld

با سلام

این کد را تست کنید و موارد مد نظر را اعلام کنید

منظور شما از این چیست؟

در شیت یک ردیف مربوط به کالایی به نام مانیتور با کد 124 خالی وارد شود یعنی اصلا جاش خالی باشه

کد PHP:


Sub test()


z1 = Cells(Rows.Count, "A").End(xlUp).Row
Z2 = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row + 1

Sheet1.Range("A2:D" & z1).Copy Destination:=Sheet2.Range("A" & Z2)

Sheet2.Select


End Sub

با تشکر از راهنمایتون منظور از خالی بودن یعنی کلا سطر خالی باشه
در ضمن کدی که نوشتید عینا هر چند سطری که هست رو با هم کپی میکنه در صورتی که من میخوام طبق عکس دوم ردیف ها تکرار بشن احتمالا نیاز به حلقه ها داره

**iranweld** · 2018/12/31, 14:15

منظور از ردیفها تکرار بشن چیه؟ یعنی دیتای مشابه پشت سره قرار بگیره؟

**sajjadstr** · 2018/12/31, 16:57

آره دوست عزیز دیتای مشابه پشت سر هم بیاد به تعدادی که جلوی هر کالا تو سلول d شیت یک نوشته میشه
مثلا فرض کن یه ردیف رو خالی گذاشتیم فرض کن اون ردیف خالی همون ردیف کالای مانیتور بود
اول کیس ها رو بنویسه
بعد موس ها رو به ترتیب همینطور الی آخر
به عبارتی فضا های خالی رو کپی نکنه تو شیت 2

**iranweld** · 2019/01/01, 11:35

در فایل پیوست یک شماره فاکتور اضافه گردیده است که میتوانید در شیت دوم با سورت کردن به خواسته خود برسید

در صورتیکه در شیت اول یک آیتم خالی باشد آن سطر کپی نمیشود.

کد PHP:


Sub test()

z1 = Cells(Rows.Count, "A").End(xlUp).Row

For i = 2 To z1

If Application.CountBlank(Range("a" & i & ":d" & i)) = 0 Then

Z2 = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row + 1

Range("a" & i & ":d" & i).Copy Destination:=Sheet2.Range("A" & Z2)

Sheet2.Range("e" & Z2) = Range("f1")


End If

Next



End Sub

فایل های پیوست شده

Myfiles 4.xls (53.5 کیلو بایت, مشاهدات 13)

**sajjadstr** · 2019/01/01, 13:46

نوشته اصلی توسط iranweld

در فایل پیوست یک شماره فاکتور اضافه گردیده است که میتوانید در شیت دوم با سورت کردن به خواسته خود برسید

در صورتیکه در شیت اول یک آیتم خالی باشد آن سطر کپی نمیشود.

کد PHP:


Sub test()

z1 = Cells(Rows.Count, "A").End(xlUp).Row

For i = 2 To z1

If Application.CountBlank(Range("a" & i & ":d" & i)) = 0 Then

Z2 = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row + 1

Range("a" & i & ":d" & i).Copy Destination:=Sheet2.Range("A" & Z2)

Sheet2.Range("e" & Z2) = Range("f1")


End If

Next



End Sub

دوست عزیز ممنون خیلی شرمندتونم وقتتون رو میگیرم ولی فکر میکنم شاید نتوتنستم درست مطلب رو توضیح بدم
نمیدونم دیگه فرصت بررسی دارید یا نه ولی خب من یه بار دیگه توضیح میدم
ببینین اکسلی که من دارم اصلا فاکتور نیست
نیازی به سورت هم نداره
باید داده ها رو به ترتیب شیت 1 بر حسب سلول تعداد تکرار کنه
به یه شکل دیگه توضیح میدم
اگر شیت 1 این عکس زیرباشه

شیت 2 باید بشه

یعنی به تعدادی که در ستون D2 شیت دو بود همان سطر را در شیت 2 تکرار می کند حالا فرض کنیم کالای دومی در شیت1 وارد می شود

شیت دو باید بشود

یعنی 5 بار سطر یک را در شیت دو تکرار کرده
و سپس 2 بار سطر 3 را تکرار می کند
حالا اگه سطر سه شیت 1 کالایی وارد نشود و مثلا سطر 4 کالایی وارد شود به شکل زیر

نتیجه در شیت دو میشه

در نتیجه جوراب پسرانه هم به تعداد D4 تکرار میشه تو شیت 2
و همینطور تا هر چی کالا وارد شد فضاهای خالی که کالا وارد نشده رو در نظر نمیگیره
فقط ترتیب مهمه نه سورت کردن منظورم اینه هرچی تو شیت1 نوشته شده به همون ترتیب پشت سر هم باید تکرار و کپی بشن تو شیت دو
کدهایی ک زحمتتون هم دادم دو دفعه دوست عزیز شما نوشتید کل سطر ها رو با هم کپی میکنه
-------------------------------------------------------
نکته: جهت اطلاع اختیاری ک بدونید شیت دو نباید توش فضای خالی بیاد و به ترتیب کالا ها باید به تعدادی که در شیت 1 هست تکرار بشن و اطلاعات و سطر و ستونی اضافه نبایدغیر از مواردی که در بالا گفتم داخل شیت 2 نوشته بشه علتش اینه اطلاعات شیت دو میشه ورودی یه نرم افزار چاپ بارکد هر سطر وستونی اضافه باعث خطا میشه
یه نرم افزاری اطاعات یه کالاهایی رو به صورت شیت 1 خروجی میده
نرم افزار دوم به صورت شیت 2 ورودی میگیره
---------------------------------------------------------
استدلال من اینه
احتمالا باید اینجوری برم جلو

کد PHP:


dim i  as integer
("D")for i=1 to rangeحالا باید بگیم بیا همون سطر رو به اندازه ستون Di 
کپی کن شیت دو

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

**iranweld** · 2019/01/01, 13:59

بفرمایید هدف نهایی شما از این کار چیه ؟

شاید راه حل بهتری وجود داشته باشه

**sajjadstr** · 2019/01/01, 17:50

نوشته اصلی توسط iranweld

بفرمایید هدف نهایی شما از این کار چیه ؟

شاید راه حل بهتری وجود داشته باشه

ببینید میخام شیت دو رو بدم به نرم افزار بارکد زن که با چاپگر مخصوص بارکد رو چاپ کنه
نرم افزارش به فرمت شیت 2 ورودی میگیره
من میخام کالاها رو در شیت یک وارد کنم بعد طبق فرمتی ک گفتم شیت دو بدست بیاد و شیت دو رو به نرم افزار معرفی کنم تا بارکد کالاهام رو چاپ کنه
نرم افزار چاپ بارکد نمی فهمه مثلا سطر 1 رو باید 5 دفعه چاپ کنه تنها در صورتی میفهمه که یه سطر براش 5 دفعه تکرار شده باشه
طبق چیزایی که بالا گفتم در حال تلاش برای تهیه یه همچین چیزی هستم
تازه با vba شروع به کار کردم هنوز مبتدی ام البته قبلا vb6 کار کردم کد ها رو میفهمم دنبال یه سرنخی تو نوع کد نوشتن شما میگردم بفهمم چطوری باید کپی و انتقال داد
تا ب نتیجه برسم مهم تر اینکه یاد هم دارم میگیرم ولی هدف نهایی من بدست آمدن شیت 2 طبق فرمتی ک گفتم هست که خیلی خیلی هم زحمتتون دادم

**iranweld** · 2019/01/01, 20:58

همین توضیح را بدین صورت شفاف اول بیان میگردید

کد PHP:


Sub test()

z1 = Cells(Rows.Count, "A").End(xlUp).Row

For i = 2 To z1

If Application.CountBlank(Range("a" & i & ":d" & i)) = 0 Then

z2 = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row + 1

For j = z2 To z2 + Range("d" & i) - 1

Range("a" & i & ":c" & i).Copy Destination:=Sheet2.Range("A" & z2)

z2 = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row + 1

Next

End If

Next

End Sub

فایل های پیوست شده

Myfiles 5.xls (42.5 کیلو بایت, مشاهدات 16)

**sajjadstr** · 2019/01/01, 21:27

خیلی ممنون خیلی عالی بود کارتون دستتون درد نکنه خیلی اذیت شدین عذر میخوام

**iranweld** · 2019/01/02, 07:40

یک اصلاحیه در کدها صورت گرفت

کد PHP:


Destination:=Sheet2.Range("A" & j)

کد PHP:


Sub test()

z1 = Cells(Rows.Count, "A").End(xlUp).Row

For i = 2 To z1

If Application.CountBlank(Range("a" & i & ":d" & i)) = 0 Then

z2 = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row + 1

For j = z2 To z2 + Range("d" & i) - 1

Range("a" & i & ":c" & i).Copy Destination:=Sheet2.Range("A" & j)

Next

End If

Next

End Sub