[حل شده] اشتباه در درج تاریخ سلول پر شده تحت شرایط خاص

[sabertb]

سلام به اساتید گرامی

چند وقت پیش با راهنمایی اساتید ماژولی نوشتم که تاریخ شمسی رو در سلول های متناظر سلول هایی که در آن اطلاعات ثبت میگردید به صورت خود کار وارد کند

ولی جدیدا متوجه یک اشکال اساسی در این ماژول شدم . زمانی که بالا یا پایین سلول خالی ای که قصد وارد کردن اطلاعات را داریم قبلا پر شده باشد (حاوی اطلاعات باشد) و بخاهیم سلول خالی این بین را پر کنیم متوجه شدم در سلول های متناظر و هم چنین سلول های بالایی و پایینی قسمت درج تاریخ . همه با هم به تاریخ روز تغییر میکنند ! در صورتی که من فقط میخواهم سلول متناظر همان سلول خالی به صورت خودکار تاریخ بگیره .
این جوری تاریخ های ثبت شده قبلی خودکار تغییر میکنه ! و به روز میشه . برای رفع این مشکل چه باید کرد ؟

در نمونه فایل ضمیمه شده. در قسمت تاریخ های خودکار (که با کاندیشن سبز مشخص شده) من بیشتر سلول هارا با عدد 11 پر کردم و فقط 2 ردیف 9 و 14 صفحه خالی است . وفتی شما در ستون های Process 1 تا Process 11 و ردیف 9 و 14 اطلاعاتی وارد میکنید به غیر از سلول های متناظرش در قسمت تاریخ سلول های بالا یا پایینی آن ها هم تغییر میکند.

[iranweld]

با سلام

ظاهرا برای اجرای ماکرو در صورت تغییر در ستون r دو ماکرو متفاوت تعریف کردید

خط پایین را غیر فعال کنید درست جواب میده

[Amir Ghasemiyan]

سلام دوست عزیز
علاوه بر نکته ای که جناب iranweld مطرح کردند دقت کنید که وقتی عددی داخل محدوده وارد میکنید و اینتر رو میزنید target شما عوض میشه و سلول پایینی انتخاب میشه
یا باید از کلیدهای ترکیبی ctrl+enter استفاده کنید یا اینکه کدتون رو اصلاح کنید که سلول بالایی target رو لحاظ کنه

[sabertb]

با سلام

ظاهرا برای اجرای ماکرو در صورت تغییر در ستون r دو ماکرو متفاوت تعریف کردید

خط پایین را غیر فعال کنید درست جواب میده

[ATTACH=CONFIG]9377[/ATTACH]

این رنج ها تکراری ولی با اسامی جدید تعریف کردم تا بتونم با وارد کردن اطلاعات در سلول و رفتن به سلول پایین هم تاریخ رو ثبت کنه . در غیر این صورت وقتی شما اون دامنه ها و ماژول هارو نداشته باشید
برای

Sub data17()

Dim i, J As Integer
Dim rowNumberValue As Integer, columnNumberValue As Integer

 rowNumberValue = ActiveCell.Row
columnNumberValue = ActiveCell.Column

If Cells(rowNumberValue - 1, 7) <> "" Then
  Cells(rowNumberValue - 1, 30) = J_TODAY(1)
    End If

End Sub
Sub data18()

Dim i, J As Integer

Dim rowNumberValue As Integer, columnNumberValue As Integer



 rowNumberValue = ActiveCell.Row
columnNumberValue = ActiveCell.Column


If Cells(rowNumberValue - 1, 8) <> "" Then
  Cells(rowNumberValue - 1, 31) = J_TODAY(1)
      
End If

End Sub

Sub data19()

Dim i, J As Integer
Dim rowNumberValue As Integer, columnNumberValue As Integer

 rowNumberValue = ActiveCell.Row
columnNumberValue = ActiveCell.Column

If Cells(rowNumberValue - 1, 9) <> "" Then
  Cells(rowNumberValue - 1, 32) = J_TODAY(1)
    End If

End Sub
Sub data20()

Dim i, J As Integer

Dim rowNumberValue As Integer, columnNumberValue As Integer



 rowNumberValue = ActiveCell.Row
columnNumberValue = ActiveCell.Column


If Cells(rowNumberValue - 1, 10) <> "" Then
  Cells(rowNumberValue - 1, 33) = J_TODAY(1)
   
End If

End Sub

Sub data21()

Dim i, J As Integer
Dim rowNumberValue As Integer, columnNumberValue As Integer

 rowNumberValue = ActiveCell.Row
columnNumberValue = ActiveCell.Column

If Cells(rowNumberValue - 1, 11) <> "" Then
  Cells(rowNumberValue - 1, 34) = J_TODAY(1)
    End If

End Sub
Sub data22()

Dim i, J As Integer

Dim rowNumberValue As Integer, columnNumberValue As Integer



 rowNumberValue = ActiveCell.Row
columnNumberValue = ActiveCell.Column


If Cells(rowNumberValue - 1, 12) <> "" Then
  Cells(rowNumberValue - 1, 35) = J_TODAY(1)
      
End If

End Sub

Sub data23()

Dim i, J As Integer
Dim rowNumberValue As Integer, columnNumberValue As Integer

 rowNumberValue = ActiveCell.Row
columnNumberValue = ActiveCell.Column

If Cells(rowNumberValue - 1, 13) <> "" Then
  Cells(rowNumberValue - 1, 36) = J_TODAY(1)
    End If

End Sub
Sub data24()

Dim i, J As Integer

Dim rowNumberValue As Integer, columnNumberValue As Integer



 rowNumberValue = ActiveCell.Row
columnNumberValue = ActiveCell.Column


If Cells(rowNumberValue - 1, 14) <> "" Then
  Cells(rowNumberValue - 1, 37) = J_TODAY(1)
   
End If

End Sub

Sub data25()

Dim i, J As Integer
Dim rowNumberValue As Integer, columnNumberValue As Integer

 rowNumberValue = ActiveCell.Row
columnNumberValue = ActiveCell.Column

If Cells(rowNumberValue - 1, 15) <> "" Then
  Cells(rowNumberValue - 1, 38) = J_TODAY(1)
    End If

End Sub
Sub data26()

Dim i, J As Integer

Dim rowNumberValue As Integer, columnNumberValue As Integer



 rowNumberValue = ActiveCell.Row
columnNumberValue = ActiveCell.Column


If Cells(rowNumberValue - 1, 16) <> "" Then
  Cells(rowNumberValue - 1, 39) = J_TODAY(1)
      
End If

End Sub

Sub data27()

Dim i, J As Integer
Dim rowNumberValue As Integer, columnNumberValue As Integer

 rowNumberValue = ActiveCell.Row
columnNumberValue = ActiveCell.Column

If Cells(rowNumberValue - 1, 17) <> "" Then
  Cells(rowNumberValue - 1, 40) = J_TODAY(1)
    End If

End Sub
Sub data28()

Dim i, J As Integer

Dim rowNumberValue As Integer, columnNumberValue As Integer



 rowNumberValue = ActiveCell.Row
columnNumberValue = ActiveCell.Column


If Cells(rowNumberValue - 1, 18) <> "" Then
  Cells(rowNumberValue - 1, 41) = J_TODAY(1)
   
End If

End Sub

Sub data29()

Dim i, J As Integer
Dim rowNumberValue As Integer, columnNumberValue As Integer

 rowNumberValue = ActiveCell.Row
columnNumberValue = ActiveCell.Column

If Cells(rowNumberValue - 1, 19) <> "" Then
  Cells(rowNumberValue - 1, 42) = J_TODAY(1)
    End If

End Sub
Sub data30()

Dim i, J As Integer

Dim rowNumberValue As Integer, columnNumberValue As Integer



 rowNumberValue = ActiveCell.Row
columnNumberValue = ActiveCell.Column


If Cells(rowNumberValue - 1, 20) <> "" Then
  Cells(rowNumberValue - 1, 43) = J_TODAY(1)
      
End If

End Sub

Sub data31()

Dim i, J As Integer
Dim rowNumberValue As Integer, columnNumberValue As Integer

 rowNumberValue = ActiveCell.Row
columnNumberValue = ActiveCell.Column

If Cells(rowNumberValue - 1, 21) <> "" Then
  Cells(rowNumberValue - 1, 44) = J_TODAY(1)
    End If

End Sub

Sub data32()

Dim i, J As Integer
Dim rowNumberValue As Integer, columnNumberValue As Integer

 rowNumberValue = ActiveCell.Row
columnNumberValue = ActiveCell.Column

If Cells(rowNumberValue - 1, 22) <> "" Then
  Cells(rowNumberValue - 1, 45) = J_TODAY(1)
    End If

End Sub 

وقتی شما اطلاعات رو زیرهم وارد کنید تاریخ نمیزنه حتما باید بعد از وارد کردن اطلاعات به سلول کناریش برید تا تاریخ ثبت بشه

[sabertb]

میدونید علت این کد نویسی چیه ؟ علتش اینه که روش وارد کردن اطلاعات ممکنه هم کنار هم باشه یعنی به صورت سطری وارد بشه هم به صورت ستونی زیر هم کم پیش میاد به صورت ستونی بالای هم وارد بشه

حالا اگه بخواهیم این وار کردن اطلاعات مشکلی برای تاریخ های بالا و پایین سلول متناظر پیش نیاره چه باید کرد

[Amir Ghasemiyan]

چیزی که من از کد شما متوجه شدم اگه درست باشه شما نیاز به هیچ کدوم از اون کدها ندارین
فقط همین چند خط کد کافیه:

Sub Worksheet_Change(ByVal Target As Range)
Cells(Target.Row, Target.Column + 23) = J_TODAY(1)
End Sub

[sabertb]

دست شما درد نکنه
فقط ت ماژول تاریخ نمی دونم چرا اررور میده

Function J_TODAY(Optional mode As Integer)

    Application.Volatile True
    Dim x1 As New DateClass
    x1.Initial
    
    If mode = 1 Then
        
        J_TODAY = FDate(x1.JToday("long"))
    Else
        J_TODAY = FDate(x1.JToday("Short"))
    End If

End Function 

[sabertb]

چیزی که من از کد شما متوجه شدم اگه درست باشه شما نیاز به هیچ کدوم از اون کدها ندارین
فقط همین چند خط کد کافیه:

Sub Worksheet_Change(ByVal Target As Range)
Cells(Target.Row, Target.Column + 23) = J_TODAY(1)
End Sub

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

[Amir Ghasemiyan]

دست شما درد نکنه
فقط ت ماژول تاریخ نمی دونم چرا اررور میده

Function J_TODAY(Optional mode As Integer)

    Application.Volatile True
    Dim x1 As New DateClass
    x1.Initial
    
    If mode = 1 Then
        
        J_TODAY = FDate(x1.JToday("long"))
    Else
        J_TODAY = FDate(x1.JToday("Short"))
    End If

End Function 

من تست کردم مشکلی نداشت. کدهاتون رو پاک کنید از اول وارد کنین. فایل رو هم ببندید دوباره باز کنید

[Amir Ghasemiyan]

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

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

Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
For Each cell In Selection
    If Not Intersect(Target, Selection) Is Nothing Then Cells(cell.Row, cell.Column + 23) = J_TODAY(1)
Next
End Sub

[sabertb]

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

Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
For Each cell In Selection
    If Not Intersect(Target, Selection) Is Nothing Then Cells(cell.Row, cell.Column + 23) = J_TODAY(1)
Next
End Sub

میتونید نمونه فایلو بزارید به بینم من کجاشو مثل شما وارد نکردم ایرادم کجاست

[Amir Ghasemiyan]

میتونید نمونه فایلو بزارید به بینم من کجاشو مثل شما وارد نکردم ایرادم کجاست

فایل نمونه خدمت شما
دقت کنید که اگه یک سلول داده دارید باید بجای enter از کلید های ترکیبی ctrl+enter استفاده کنید

[sabertb]

فایل نمونه خدمت شما
دقت کنید که اگه یک سلول داده دارید باید بجای enter از کلید های ترکیبی ctrl+enter استفاده کنید

ممنون از راهنماییتون در نگاه اول بنظر میرسید همه چی درست هست منم حل مسئله رو زدم . ولی بعد وقتی خواست اطلاعات ام رو وارد کنم دیدم هرجا هرچی کپی میکنم (حتی چیز هایی که لازم نیست تاریخش ثبت بشه که زیادم هست) فایل شروع به ثبت تاریخ میکند که خیلی خیلی زمان بر است و لازم هم نیست . می خواستم اگر میشه این قابلیت تو رنج مشخصی عمل کنه مثلا بین h9:u10000 وقتی اطلاعات وارد شد تاریخش به صورت متناظر همون سلول 23 تا جولوترش وارد بشه.

[Amir Ghasemiyan]

ممنون از راهنماییتون در نگاه اول بنظر میرسید همه چی درست هست منم حل مسئله رو زدم . ولی بعد وقتی خواست اطلاعات ام رو وارد کنم دیدم هرجا هرچی کپی میکنم (حتی چیز هایی که لازم نیست تاریخش ثبت بشه که زیادم هست) فایل شروع به ثبت تاریخ میکند که خیلی خیلی زمان بر است و لازم هم نیست . می خواستم اگر میشه این قابلیت تو رنج مشخصی عمل کنه مثلا بین h9:u10000 وقتی اطلاعات وارد شد تاریخش به صورت متناظر همون سلول 23 تا جولوترش وارد بشه.

خب یک شرط ساده اولش بذارین. به این صورت:
if intersect(target,range("h9:u10000" then

بقیه برنامه


end if

[sabertb]

خب یک شرط ساده اولش بذارین. به این صورت:
if intersect(target,range("h9:u10000" then

بقیه برنامه


end if

سلام خیلی خیلی ممنون از راهنماییتون . واقعیت اینه که خیلی در مورد VB اطلاعات ندارم و همیشه با صحیح و خطا و تغییر برخی پارامتر ها که ازشون سر در میارم کد های اساتید رو برای فرم های مختلف همهنگ میکنم ولی بعضی وقتا مثل الان مشکل دارم در مورد قرار دادن شرط در جای خودش هر جا میزارم اررور میده . قبل از Sub میزارم اررور میده بعدش میزارم اررور میده یه بار از Next اررو میگیره یه بار از شرط هنوز نتونستم روش درستش رو درک کنم .

Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
For Each cell In Selection
        If Intersect(Target, Range("h9:u10000")) Then Cells(cell.Row, cell.Column + 23) = J_TODAY(1)
Next
End If
End Sub 

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