واحد های فروش اتوماتیک در فاکتور

[ali_nmt]

سلام
در فاکتور فروش و لیست فاکتور سه سلول دارم به ترتیب :
واحد فرعی واحد اصلی تعداد
مثلا 50 بسته 20 تایی میشه 1000 عدد
میخوام وقتی جوری باشه که دو سلول رو پر میکنم سلول سوم خودش اتومات پر بشه
مثلا بنویسم 50 ----- 20 ----- 1000 رو خودش بیاره
و وقتی هم بنویسم .......... -------20 --------- 1000 در سلول اول 50 رو خودش بیاره
یا مثلا بنویسم 50 ------- ................. ----------- 1000 در سلول وسطی 20 رو خودش بیاره

[saed.rasa]

سلام

میشه خواهش کنم ی فایل نمونه همراه مثال قرار دهید لطفا

مرسی

[ali_nmt]

بله حتما خدمت شما :



سلام

میشه خواهش کنم ی فایل نمونه همراه مثال قرار دهید لطفا

مرسی

[saed.rasa]

سلام

راستش، من خودم هم همین مشکل دارم و خوشحال می شوم به من هم دوستان کمک کنند

به نظر میاد این کار در اکسل امکان پذیر نمی باشد
راه آخر vba است که من بلد نیستم
از دوستان خواهش می کنم که ما را راهنمایی فرمایند لطفا

مرسی

[yuri]

با دو سه ساعت آموزش vba تونستم این کد رو بنویسم



Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Dim x As Integer
For x = 2 To 7
If Cells(x, 3).Value = "" Or Cells(x, 1).Value > 0 Or Cells(x, 2).Value > 0 Then
Cells(x, 3).Value = Cells(x, 1).Value * Cells(x, 2).Value
ElseIf Cells(x, 2).Value = "" Or Cells(x, 1).Value > 0 Or Cells(x, 3).Value > 0 Then
Cells(x, 2).Value = Cells(x, 3).Value / Cells(x, 1).Value
ElseIf Cells(x, 1).Value = "" Or Cells(x, 2).Value > 0 Or Cells(x, 3).Value > 0 Then
Cells(x, 1).Value = Cells(x, 3).Value / Cells(x, 2).Value
End If
Next x
End Sub


22665

[generalsamad]

با سلام
کدتون رو اصلاح کنید به جای or از and استفاده کنید


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Dim x As Integer
For x = 2 To 7
If Cells(x, 3).Value = "" And Cells(x, 1).Value > 0 And Cells(x, 2).Value > 0 Then
Cells(x, 3).Value = Cells(x, 1).Value * Cells(x, 2).Value
End If
If Cells(x, 2).Value = "" And Cells(x, 1).Value > 0 And Cells(x, 3).Value > 0 Then
Cells(x, 2).Value = Cells(x, 3).Value / Cells(x, 1).Value
End If
If Cells(x, 1).Value = "" And Cells(x, 2).Value > 0 And Cells(x, 3).Value > 0 Then
Cells(x, 1).Value = Cells(x, 3).Value / Cells(x, 2).Value
End If
Next x
End Sub

[yuri]

اولش and بود و مشکلی که داشت به روز نمیشد یعنی 5 ضربدر 1 میکردم جواب رو میاورد 5 و بعدش میخواستم ویرایش کنم یعنی مثلا 5 رو ضرب در 5 کنم جواب همون 5 میموند و باید یکبار روی جواب دلت میکردم تا آپدیت میشد (یعنی 5 * 5 میشد 25)
and ها رو تبدیل به or کردم ولی این دفعه مشکل دیگه ای درست شد یه کد طولانی دیگه نوشتم باز هم کامل نبود
اگر امکانش هست شما تکمیلش کنید
نمیدونم شاید توابع دیگه ای لازم هست که من بلد نیستم یا شاید هم با همین ترکیبات و تغییرات داخلش قابل حل هست
من در اینجا جدول معمولی با تعداد سطر معلوم رو مثال زدم که x رو 2 تا 7 در نظر گرفتم ولی معمولا تیبل ایجاد میکنیم و تعداد سطر ها شاید تا هزاران مورد هم برسه


با سلام
کدتون رو اصلاح کنید به جای or از and استفاده کنید


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Dim x As Integer
For x = 2 To 7
If Cells(x, 3).Value = "" And Cells(x, 1).Value > 0 And Cells(x, 2).Value > 0 Then
Cells(x, 3).Value = Cells(x, 1).Value * Cells(x, 2).Value
End If
If Cells(x, 2).Value = "" And Cells(x, 1).Value > 0 And Cells(x, 3).Value > 0 Then
Cells(x, 2).Value = Cells(x, 3).Value / Cells(x, 1).Value
End If
If Cells(x, 1).Value = "" And Cells(x, 2).Value > 0 And Cells(x, 3).Value > 0 Then
Cells(x, 1).Value = Cells(x, 3).Value / Cells(x, 2).Value
End If
Next x
End Sub

[generalsamad]

ببینید همین مد نظرتون هست؟

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Dim x, LastRow As Integer
LastRow = Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
For x = 2 To LastRow
If Cells(x, 3).Value = "" And Cells(x, 1).Value > 0 And Cells(x, 2).Value > 0 Then
Cells(x, 3).Value = Cells(x, 1).Value * Cells(x, 2).Value
End If
If Cells(x, 2).Value = "" And Cells(x, 1).Value > 0 And Cells(x, 3).Value > 0 Then
Cells(x, 2).Value = Cells(x, 3).Value / Cells(x, 1).Value
End If
If Cells(x, 1).Value = "" And Cells(x, 2).Value > 0 And Cells(x, 3).Value > 0 Then
Cells(x, 1).Value = Cells(x, 3).Value / Cells(x, 2).Value
End If
Next x
End Sub

[yuri]

درسته همینه فقط نمیشه اسم تیبل با اسم ستون رو بهش داد؟ به جای اینکه بنویسم (x,1) بنویسم (فروش[تعدادجز] , x) ؟
و اینکه اگر امکانش هست مشکل این کد رو هم که در کامنت قبلی گفتم رو درست کنید



ببینید همین مد نظرتون هست؟

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Dim x, LastRow As Integer
LastRow = Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
For x = 2 To LastRow
If Cells(x, 3).Value = "" And Cells(x, 1).Value > 0 And Cells(x, 2).Value > 0 Then
Cells(x, 3).Value = Cells(x, 1).Value * Cells(x, 2).Value
End If
If Cells(x, 2).Value = "" And Cells(x, 1).Value > 0 And Cells(x, 3).Value > 0 Then
Cells(x, 2).Value = Cells(x, 3).Value / Cells(x, 1).Value
End If
If Cells(x, 1).Value = "" And Cells(x, 2).Value > 0 And Cells(x, 3).Value > 0 Then
Cells(x, 1).Value = Cells(x, 3).Value / Cells(x, 2).Value
End If
Next x
End Sub

[smartman]

دقت کنید کدهایی که در ایونت Worksheet_SelectionChange می‌نویسید تا مقادیر سلول‌ها را تغییر دهند، باعث از دست رفتن عملکرد Undo می‌شوند که گاها این موضوع منجر به نتایج فاجعه‌باری می‌شود.
توصیه من این است که حتی‌الامکان از سلول‌های کمکی و Named Range یا روش‌های دیگری استفاده کنید.

[yuri]

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



دقت کنید کدهایی که در ایونت Worksheet_SelectionChange می‌نویسید تا مقادیر سلول‌ها را تغییر دهند، باعث از دست رفتن عملکرد Undo می‌شوند که گاها این موضوع منجر به نتایج فاجعه‌باری می‌شود.
توصیه من این است که حتی‌الامکان از سلول‌های کمکی و Named Range یا روش‌های دیگری استفاده کنید.

[saed.rasa]

سلام

Smartman عزیز و گرامی

اگر فکر می کنید با سلول کمکی یا Name Maneger این کار امکان پذیر است نمونه مثال در اکسل ارائه دهید لطفا

مرسی
دقت کنید کدهایی که در ایونت Worksheet_SelectionChange می‌نویسید تا مقادیر سلول‌ها را تغییر دهند، باعث از دست رفتن عملکرد Undo می‌شوند که گاها این موضوع منجر به نتایج فاجعه‌باری می‌شود.
توصیه من این است که حتی‌الامکان از سلول‌های کمکی و Named Range یا روش‌های دیگری استفاده کنید.