[حل شده] درج تاریخ اتوماتیک وقتی سلول پر میشود با کد ماکرو

[absolute455]

سلام من 2تا فایل آپلود کردم. یکی دفتر برگشتی خودم، دیگری فایل اکسل حاوی کد vba برای درج تاریخ اتوماتیکی که از همین سایت از یک موضوع دیگه دانلود کردم.

کد VBA مربوطه رو وقتی که من در فایل اکسل خودم الصاق کردم و تغییرات لازم رو دادم، نتیجه به این صورت شد:
"در صورتی که در سطری از ستون اول دیتا وارد شود، در سطر مورد نظر از ستون سوم تاریخ را درج کن"

1) من میخام این کد به این صورت تغییر پیدا کنه:
در صورتی که در سطری از ستون (اول "یا" دوم) دیتا وارد شود... (بقیش مثل همون)

2) همچنین این رو هم میخام اضافه بشه که اگر دیتا در سطر مورد نظر از ستون (اول "و" دوم) پاک شد، تاریخ هم پاک بشه.

چکار کنم کجای کد ماکرو رو تغییر بدم که این اتفاقاتی که من میخام حاصل بشه؟
از اساتیدی که وقت میذارن و سوال بنده رو جواب میدن بسیار متشکرم

[iranweld]

با سلام

فایل پیوست را بررسی کنید

[absolute455]

وای این سایت فوق العادست.
از شما بسیار ممنونم مشکلم حل شد.

فقط 2تا سوال دیگه هم داشتم اونم این که چطور فرمت تاریخ رو به این صورت در بیارم: "چهارشنبه 25 مرداد 97" "پنجشنبه 26 مرداد 97" و الی آخر.

اون یکی هم اینکه فرض کنید بخام علاوه بر این شیت، در یک شیت دیگر هم همین بحث تاریخ اتوماتیک رو راه بندازم یا در چند شیت تاریخ اتومات داشته باشم. چکار باید بکنم بگید ممنون میشم.
الان همین یک شیت رو اگر بخام در فایل خودم راه بندازم، آیا به همین صورتی که شما چیدمان رو انجام دادید منم انجام بدم( کد های شیت یک در شیت یک، کد های شیتی که میخام تاریخ اتومات داخلش درج بشه در اون شیت بذارم[محتویات فولدر ماژول و کلس ماژول رو هم که عینا باید کپی کنم در ورک شیت خودم]) درست میشه؟


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

[iranweld]

برای اضافه شدن روز در کنار تاریخ

Cells(rowNumber, 3) = J_TODAY(1) & " " & J_WEEKDAY(J_TODAY(1), 1) 

Sub Worksheet_Change(ByVal Target As Range)

 If Not Intersect(Target, Me.Range("A2:b50000")) Is Nothing Then
    
    
 Application.EnableEvents = False

Dim rowNumber As Integer

rowNumber = Target.Row

If Cells(rowNumber, 3) = "" Then

  Cells(rowNumber, 3) = J_TODAY(1) & " " & J_WEEKDAY(J_TODAY(1), 1)
   
End If

If Cells(rowNumber, 1) = "" And Cells(rowNumber, 2) = "" Then

Cells(rowNumber, 3) = ""
   
End If

Application.EnableEvents = True

End If

End Sub 

برای ایجاد فایل جدید ، ماژولهای تاریخ شمسی نیز باید منتقل شوند

برای شیت های دیگر نیز همین کدها را در قسمت کد نویسی هر شیت کپی نمایید

[absolute455]

اخه ببینید 2تا کد داریم با ماژول ها.
ماژول ها که عینا کپی میشن مشکلی نیستش.
کد اول این هستش:

Sub Worksheet_Change(ByVal Target As Range)    If Not Intersect(Target, Me.Range("B2:B50000")) Is Nothing Then Data
    If Not Intersect(Target, Me.Range("E2:E50000")) Is Nothing Then Data2
End Sub

این کد رو وقتی من تو شیت دیتا بیس (در محیط ماکرو) دابل کلیک میکنم، این کد میاد.

کد دوم این کد هستش:

Sub Worksheet_Change(ByVal Target As Range)

 If Not Intersect(Target, Me.Range("A2:b50000")) Is Nothing Then
    
    
 Application.EnableEvents = False


Dim rowNumber As Integer


rowNumber = Target.Row


If Cells(rowNumber, 3) = "" Then


  Cells(rowNumber, 3) = J_TODAY(1) & " " & J_WEEKDAY(J_TODAY(1), 1)
   
End If


If Cells(rowNumber, 1) = "" And Cells(rowNumber, 2) = "" Then


Cells(rowNumber, 3) = ""
   
End If


Application.EnableEvents = True


End If


End Sub

این کد رو زمانی که بر شیت "برگشت از فروش" دابل کلیک میکنم، این کد میاد.

حالا سوال من اینجاست:
آیا فقط کد دوم رو در شیت جدید کپی کنم؟ چون شما تو جمله ای که برای من پست کردید، نوشتید "کد هارو".
سوال بعدی هم اینکه ستون های شیت بعدیم فرق میکنه اعداد رو چطوری تغییر بدم؟
بعد ما در ستون data base اصلا کاری نداریم چرا اونجا هم یک کد ماکرو ایجاد شده؟
فایل رو فرستادم که شیت جدید هم داخلش هست.

[iranweld]

با سلام

فایل پیوست را بررسی بفرمایید
کدهای موجود در data base اشتباه بود

Sub Worksheet_Change(ByVal Target As Range)

 If Not Intersect(Target, Me.Range("b4:d50000")) Is Nothing Then
    
    
 Application.EnableEvents = False

Dim rowNumber As Integer

rowNumber = Target.Row

If Cells(rowNumber, 1) = "" Then

  Cells(rowNumber, 1) = J_TODAY(1) & " " & J_WEEKDAY(J_TODAY(1), 1)
   
End If

If Cells(rowNumber, 2) = "" And Cells(rowNumber, 3) = "" And Cells(rowNumber, 4) = "" Then

Cells(rowNumber, 1) = ""
   
End If

Application.EnableEvents = True

End If
   
End Sub 

[امين اسماعيلي]

ba drod farvan, mibinam bade in hame vaght ke nistim hanozam hamon asho hamon kasas, gharar nist inja be kasi mahi giri yad dade beshe, engar ,dost aziz va gerami man, sat konin az paye yadgiri ro shoro koin, ghabl az soal porsidan, hatman search konin, yekam talash koni, ba code ha dasto panjei narm konin, injori yad migirin, loghme amade be hich darde kasi nemikhore, faghat zemni moshkeletono hal mikone.

[iranweld]

با سلام خدمت مهندس اسماعیلی مدیریت محترم تالار

با توجه به اینکه دوستان با مشغله شغلی زیاد در محیط کار خود به مشکلی برخورد میکنند به این سایت مراجعه میکنند و مبحث کدنویسی برای کسی که تاکنون کار نکرده بسیار سنگین میباشد .
بنابر این در اختیار قرار دادن تجربیات چند ساله به این عزیزان مقدمه ای برای شروع یادگیری مطالب جدیدتر در اکسل برای آنها میباشد
بنابر این با ارسال کدها و فایل آماده شده میتواند کمک بزرگی برای این افراد باشد.

بازدیدهای روزانه زیاد و اعتماد و رضایت کسانی که به این سایت مراجعه میکنند بیانگر سیاست درست این سایت در این زمینه میباشد.