انتقال اطلاعات فاکتور به شیت دیگر با استفاده از vba

[ebrahim41]

با سلام
یک فایل فاکتور دارم که می خواهم اطلاعات مربوط به شماره فاکتور ، تاریخ فاکتور ،جمع مبلغ ، تخفیف و ....... رو به شیت 2 انتقال بده بعدش یک شماره به شماره فاکتور اضافه کنه و فاکتور رو خالی بزاره برای اطلاعات جدید خودم یه چیزایی نوشتم اما نمی دونم چرا به جای اینکه اون رو تو یک سطر ذخیره کنه تو 16 سطر اونه تکرار می کنه
ممنون می شم کسی کمکم کنه
فایل رو هم میفرستم

[Ali Parsaei]

سلام،
اولا" که سوالتان را بايد در قسمت ويژوال بيسيک مطرح مي کرديد، ثانيا":
راستش کد شما خيلي شلوغ بود، با اين وجود تا آنجا که من تونستم بفهمم اگر اون خط که نوشته M=M+1 را از کد حذف کنيد مشکل حل خواهد شد.
ولي کلا" خيلي ساده تر مي توانيد بنويسيد، براي اخطار خالي بودن خانه تاريخ نوشتن متني در پايين فاکتور را در نظر گرفته ايد، در صورتي که ظاهر شدن يک پيغام مناسب تر است.
براي پاک کردن فاکتور هم مي توانيد از نام گذاري محدوده ها کمک بگيريد
به اين صورت که همه خانه ها که مي خواهيد بعد از ثبت فاکتور پاک شوند را انتخاب و يک نام به آنها اختصاص دهيد.
بعد در کدنويسي فقط يک خط بنويسيد (مثلا" اگر محدوده را به نام PACK ناميده باشيد مي توانيد بنويسيد: ""= Sheet1.Range("PACK").Value
من يک کد نوشته ام شايد از آن براي ساده تر نوشتن بتوانيد الگو بگيريد
چهار قسمت دارد که آنها را يک کم از هم فاصله داده ام
قسمت اول براي اخطار تاريخ است
قسمت دوم براي انتخاب اولين خانه خالي در ستون اول شيت دو است
قسمت سوم براي جايگزين کردن مقادير فاکتور در سطر خالي پيدا شده در شيت دو است
قسمت چهارم هم براي پاک کردن فاکتور و اضافه کردن يک شماره به فاکتور قبلي است
مشکلي بود در خدمتم:

Private Sub CommandButton1_Click()

If Sheet1.Cells(2, 7) = "" Then
MsgBox "تاريخ وارد شود", vbOKOnly
Exit Sub
End If

Sheet2.Activate
If Sheet2.Cells(1, 2) = "" Then
Sheet2.Cells(1, 2).Select
Else
Sheet2.Cells(1, 1).Select
Selection.End(xlDown).Offset(1, 0).Select
End If

Selection.Value = Sheet1.Cells(2, 7).Value
Selection.Offset(0, 1).Value = Sheet1.Cells(2, 3).Value
Selection.Offset(0, 2).Value = Sheet1.Cells(22, 8).Value
Selection.Offset(0, 3).Value = Sheet1.Cells(23, 8).Value
Selection.Offset(0, 4).Value = Sheet1.Cells(24, 8).Value
Selection.Offset(0, 5).Value = Sheet1.Cells(25, 8).Value
Selection.Offset(0, 6).Value = Sheet1.Cells(26, 8).Value
Selection.Offset(0, 7).Value = Sheet1.Cells(27, 8).Value

Sheet1.Range("PACK").Value = ""
Sheet1.Activate
Cells(2, 3).Value = Cells(2, 3).Value + 1

End Sub 

[ebrahim41]

سلام،
اولا" که سوالتان را بايد در قسمت ويژوال بيسيک مطرح مي کرديد، ثانيا":
راستش کد شما خيلي شلوغ بود، با اين وجود تا آنجا که من تونستم بفهمم اگر اون خط که نوشته M=M+1 را از کد حذف کنيد مشکل حل خواهد شد.
ولي کلا" خيلي ساده تر مي توانيد بنويسيد، براي اخطار خالي بودن خانه تاريخ نوشتن متني در پايين فاکتور را در نظر گرفته ايد، در صورتي که ظاهر شدن يک پيغام مناسب تر است.
براي پاک کردن فاکتور هم مي توانيد از نام گذاري محدوده ها کمک بگيريد
به اين صورت که همه خانه ها که مي خواهيد بعد از ثبت فاکتور پاک شوند را انتخاب و يک نام به آنها اختصاص دهيد.
بعد در کدنويسي فقط يک خط بنويسيد (مثلا" اگر محدوده را به نام PACK ناميده باشيد مي توانيد بنويسيد: ""= Sheet1.Range("PACK").Value
من يک کد نوشته ام شايد از آن براي ساده تر نوشتن بتوانيد الگو بگيريد
چهار قسمت دارد که آنها را يک کم از هم فاصله داده ام
قسمت اول براي اخطار تاريخ است
قسمت دوم براي انتخاب اولين خانه خالي در ستون اول شيت دو است
قسمت سوم براي جايگزين کردن مقادير فاکتور در سطر خالي پيدا شده در شيت دو است
قسمت چهارم هم براي پاک کردن فاکتور و اضافه کردن يک شماره به فاکتور قبلي است
مشکلي بود در خدمتم:

Private Sub CommandButton1_Click()

If Sheet1.Cells(2, 7) = "" Then
MsgBox "تاريخ وارد شود", vbOKOnly
Exit Sub
End If

Sheet2.Activate
If Sheet2.Cells(1, 2) = "" Then
Sheet2.Cells(1, 2).Select
Else
Sheet2.Cells(1, 1).Select
Selection.End(xlDown).Offset(1, 0).Select
End If

Selection.Value = Sheet1.Cells(2, 7).Value
Selection.Offset(0, 1).Value = Sheet1.Cells(2, 3).Value
Selection.Offset(0, 2).Value = Sheet1.Cells(22, 8).Value
Selection.Offset(0, 3).Value = Sheet1.Cells(23, 8).Value
Selection.Offset(0, 4).Value = Sheet1.Cells(24, 8).Value
Selection.Offset(0, 5).Value = Sheet1.Cells(25, 8).Value
Selection.Offset(0, 6).Value = Sheet1.Cells(26, 8).Value
Selection.Offset(0, 7).Value = Sheet1.Cells(27, 8).Value

Sheet1.Range("PACK").Value = ""
Sheet1.Activate
Cells(2, 3).Value = Cells(2, 3).Value + 1

End Sub 

سلام
درود بر شما خیلی از راهنمایی شما متشکرم بنده خیلی در vba سر رشته ندارم با مطالعه یک کتاب اون کدها رو نوشته بودم . کدهای شما رو کپی کردم محدوده رو هم نام گذاری کردم ام با خطا مواجه شدم که خطا مربوط به قسمت زیر می باشد
Selection.End(xlDown).Offset(1, 0).Select

[ebrahim41]

سلام،
اولا" که سوالتان را بايد در قسمت ويژوال بيسيک مطرح مي کرديد، ثانيا":
راستش کد شما خيلي شلوغ بود، با اين وجود تا آنجا که من تونستم بفهمم اگر اون خط که نوشته M=M+1 را از کد حذف کنيد مشکل حل خواهد شد.
ولي کلا" خيلي ساده تر مي توانيد بنويسيد، براي اخطار خالي بودن خانه تاريخ نوشتن متني در پايين فاکتور را در نظر گرفته ايد، در صورتي که ظاهر شدن يک پيغام مناسب تر است.
براي پاک کردن فاکتور هم مي توانيد از نام گذاري محدوده ها کمک بگيريد
به اين صورت که همه خانه ها که مي خواهيد بعد از ثبت فاکتور پاک شوند را انتخاب و يک نام به آنها اختصاص دهيد.
بعد در کدنويسي فقط يک خط بنويسيد (مثلا" اگر محدوده را به نام PACK ناميده باشيد مي توانيد بنويسيد: ""= Sheet1.Range("PACK").Value
من يک کد نوشته ام شايد از آن براي ساده تر نوشتن بتوانيد الگو بگيريد
چهار قسمت دارد که آنها را يک کم از هم فاصله داده ام
قسمت اول براي اخطار تاريخ است
قسمت دوم براي انتخاب اولين خانه خالي در ستون اول شيت دو است
قسمت سوم براي جايگزين کردن مقادير فاکتور در سطر خالي پيدا شده در شيت دو است
قسمت چهارم هم براي پاک کردن فاکتور و اضافه کردن يک شماره به فاکتور قبلي است
مشکلي بود در خدمتم:

Private Sub CommandButton1_Click()

If Sheet1.Cells(2, 7) = "" Then
MsgBox "تاريخ وارد شود", vbOKOnly
Exit Sub
End If

Sheet2.Activate
If Sheet2.Cells(1, 2) = "" Then
Sheet2.Cells(1, 2).Select
Else
Sheet2.Cells(1, 1).Select
Selection.End(xlDown).Offset(1, 0).Select
End If

Selection.Value = Sheet1.Cells(2, 7).Value
Selection.Offset(0, 1).Value = Sheet1.Cells(2, 3).Value
Selection.Offset(0, 2).Value = Sheet1.Cells(22, 8).Value
Selection.Offset(0, 3).Value = Sheet1.Cells(23, 8).Value
Selection.Offset(0, 4).Value = Sheet1.Cells(24, 8).Value
Selection.Offset(0, 5).Value = Sheet1.Cells(25, 8).Value
Selection.Offset(0, 6).Value = Sheet1.Cells(26, 8).Value
Selection.Offset(0, 7).Value = Sheet1.Cells(27, 8).Value

Sheet1.Range("PACK").Value = ""
Sheet1.Activate
Cells(2, 3).Value = Cells(2, 3).Value + 1

End Sub 

با سلام مجدد
البته اون خط m=m+1 رو که پاک می کنم در شیت 2 اطلاعات جدید رو جایگزین اطلاعات قدیمی می کنه
با تشکر از شما

[ebrahim41]

سلام،
اولا" که سوالتان را بايد در قسمت ويژوال بيسيک مطرح مي کرديد، ثانيا":
راستش کد شما خيلي شلوغ بود، با اين وجود تا آنجا که من تونستم بفهمم اگر اون خط که نوشته M=M+1 را از کد حذف کنيد مشکل حل خواهد شد.
ولي کلا" خيلي ساده تر مي توانيد بنويسيد، براي اخطار خالي بودن خانه تاريخ نوشتن متني در پايين فاکتور را در نظر گرفته ايد، در صورتي که ظاهر شدن يک پيغام مناسب تر است.
براي پاک کردن فاکتور هم مي توانيد از نام گذاري محدوده ها کمک بگيريد
به اين صورت که همه خانه ها که مي خواهيد بعد از ثبت فاکتور پاک شوند را انتخاب و يک نام به آنها اختصاص دهيد.
بعد در کدنويسي فقط يک خط بنويسيد (مثلا" اگر محدوده را به نام PACK ناميده باشيد مي توانيد بنويسيد: ""= Sheet1.Range("PACK").Value
من يک کد نوشته ام شايد از آن براي ساده تر نوشتن بتوانيد الگو بگيريد
چهار قسمت دارد که آنها را يک کم از هم فاصله داده ام
قسمت اول براي اخطار تاريخ است
قسمت دوم براي انتخاب اولين خانه خالي در ستون اول شيت دو است
قسمت سوم براي جايگزين کردن مقادير فاکتور در سطر خالي پيدا شده در شيت دو است
قسمت چهارم هم براي پاک کردن فاکتور و اضافه کردن يک شماره به فاکتور قبلي است
مشکلي بود در خدمتم:

Private Sub CommandButton1_Click()

If Sheet1.Cells(2, 7) = "" Then
MsgBox "تاريخ وارد شود", vbOKOnly
Exit Sub
End If

Sheet2.Activate
If Sheet2.Cells(1, 2) = "" Then
Sheet2.Cells(1, 2).Select
Else
Sheet2.Cells(1, 1).Select
Selection.End(xlDown).Offset(1, 0).Select
End If

Selection.Value = Sheet1.Cells(2, 7).Value
Selection.Offset(0, 1).Value = Sheet1.Cells(2, 3).Value
Selection.Offset(0, 2).Value = Sheet1.Cells(22, 8).Value
Selection.Offset(0, 3).Value = Sheet1.Cells(23, 8).Value
Selection.Offset(0, 4).Value = Sheet1.Cells(24, 8).Value
Selection.Offset(0, 5).Value = Sheet1.Cells(25, 8).Value
Selection.Offset(0, 6).Value = Sheet1.Cells(26, 8).Value
Selection.Offset(0, 7).Value = Sheet1.Cells(27, 8).Value

Sheet1.Range("PACK").Value = ""
Sheet1.Activate
Cells(2, 3).Value = Cells(2, 3).Value + 1

End Sub 

سلام
درود بر شما خیلی از راهنمایی شما متشکرم بنده خیلی در vba سر رشته ندارم با مطالعه یک کتاب اون کدها رو نوشته بودم . کدهای شما رو کپی کردم محدوده رو هم نام گذاری کردم ام با خطا مواجه شدم که خطا مربوط به قسمت زیر می باشد
Selection.End(xlDown).Offset(1, 0).Select
البته m=m+1 رو پاک کردم ولی باعث شد که با ثبت کردن اطلاعات، در شیت 2 اطلاعات جدید جایگزین اطلاعات قبلی بشه

[Ali Parsaei]

بله، در مورد

m=m+1

درست مي فرماييد، پس کد شما يک اشکال ديگر هم دارد که بايد اصلاح گردد، ولي راستش پيدا کردن اشکالش از نوشتن کد جديد برايم دشوارتر بود، من خودم هم خيلي زياد به کد هاي VBA مسلط نيستم،
در مورد کد خودم هم شرمنده ام، قسمت دوم کد يک اشکال کوچک داشت و بايد بدين صورت تصحيح گردد:

Sheet2.Activate
If Sheet2.Cells(2, 1) = "" Then
Sheet2.Cells(2, 1).Select
Else
Sheet2.Cells(1, 1).Select
Selection.End(xlDown).Offset(1, 0).Select
End If 

يک توضيح هم در مورد اين قسمت مي دهم،
تفسير اين قسمت کد بدينگونه است که مي گويد:
شيت دو را فعال کن
اگر خانه A2 (يعني سطر دوم از ستون اول) خالي بود ... سپس:
همان خانه A2 را در حالت انتخاب قرار بده
وگرنه:
خانه A1 را در حالت انتخاب قرار بده
از خانه انتخاب شده برو به سمت پايين تا انتهاي محدوده اي که در همان ستون نوشته اي وجود دارد و بعد باز يک سطر و صفر ستون هم جابجا شو و خانه حاصله را در حالت انتخاب قرار بده
انتهاي شرط.

(اون قسمت (Selection.End(xlDown بدين معني است که از خانه انتخاب شده برو به سمت پايين تا انتهاي محدوده اي که در همان ستون نوشته اي وجود دارد و در ادامـــه اون قسمت (Offset(1, 0 هم بدين معني است که باز هم به اندازه يک سطر و صفر ستون پايين تر برو)

من قسمت اول را اشتباها" به جاي (Cells(2, 1 نوشته بودم (Cells(1, 2 !!!!!
فايل اصلاحي را هم ضميمه مي کنم، فقط حواستان باشد که محدوده را درست نام نهاده باشم، من طوري محدوده را انتخاب کردم که نام خريدار و فروشنده و کد کالا را هم کلا" پاک کند
اين هم فايل خدمت شما:

[ebrahim41]

با سلام خدمت جناب آقای پارسا
از اینکه وقت گذاشتید و سوال منو جواب دادید ازشما تشکر می کنم . دقیقا همون چیزی که مد نظرم بود انجام شد فقط سوالم اینه که آیا تا آخرین سطر شیت 2 این کار رو انجام می ده یعنی محدودیتی برا ثبت فاکتور ها نداره . در ضمن اگه لطف کنید یک کتاب خوب هم در مورد vba که مطالب رو ساده گفته باشه و مثال هم داشته باشه معرفی کنید
با تشکر از شما

[Ali Parsaei]

خواهش مي کنم، کاري نکردم،
بله تا آخرين سطر انجام مي دهد و محدوديتي در ثبت فاکتور ندارد.
فکر نکنم کتابهاي زيادي در مورد VBA در بازار وجود داشته باشد! بايد ببينيد در کتاب فروشي ها چه کتاب هايي هست و از بين آنها يکي را انتخاب کنيد!
همين که کليت امر را توضيح داده باشد خيلي کمک مي کند. با تمرين خيلي مي توانيد پيش برويد، در سايت نمونه فايل هاي خوبي هست و مي توانيد آنها را بررسي کنيد و در فروشگاه سايت هم احتمالا" بسته هاي آموزشي در مورد VBA بايد يافت شود که در صورت تمايل مي توانيد خريداري کنيد.
خيلي چيزها را هم با ضبط ماکرو هاي خود اکسل و بررسي کدهاي حاصله در موقع ضبط مي توانيد ياد بگيريد.
به فرض شروع به ضبط يک ماکرو کنيد و سپس کليد کنترل را نگه داشته و فلش سمت پايين روي کيبورد را فشار دهيد و بعد ماکرو را قطع کنيد و کد به دست آمده را مشاهده کنيد.
شما در هر خانه اکسل که باشيد با کليد کنترل و فلش سمت پايين به انتهاي محدوده اطلاعات در ستون سل انتخابي خواهيد رفت.
حال با ضبط ماکرويي که گفتم کد مربوط به اين عمليات را توانسته ايد استخراج کنيد که مي شود:

(Selection.End(xlDown

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

[ebrahim41]

ممنون از شما