قفل کردن فایل اکسل

[مجید ایرج]

کسی نیست جواب سوال مارو بده؟؟

[iranweld]

کسی نیست جواب سوال مارو بده؟؟

با سلام

از کدهای ذیل استفاده کنید

Sub worksheet_change(ByVal target As Range)

If Not Intersect(target, Me.Range("A:A,B:B,C:C,D:D,E:E,F:F")) Is Nothing _
Or Not Intersect(target, Me.Range("G:G,H:H,I:I,J:J,K:K,L:L,M:M,N:N")) Is Nothing Then

Application.EnableEvents = False

    target.Offset(0, 1).Value = target.Value
            
         Application.EnableEvents = True
         
         End If
         
 '============================='
         
  If Not Intersect(target, Me.Range("S9")) Is Nothing Then

Application.EnableEvents = False
  
  Range("A1") = target.Value
    
         Application.EnableEvents = True
         End If
     
     
     End Sub 

[مجید ایرج]

جناب iranweld امکانش هست از طریق اسکایپ باهم صحبت کنیم تا مشکلم حل بشه؟؟ با تشکر

[مجید ایرج]

با سلام

از کدهای ذیل استفاده کنید

sub worksheet_change(byval target as range)

if not intersect(target, me.range("a:a,b:b,c:c,d:d,e:e,f:f")) is nothing _
or not intersect(target, me.range("g:g,h:h,i:i,j:j,k:k,l:l,m:m,n:n")) is nothing then

application.enableevents = false

    target.offset(0, 1).value = target.value
            
         application.enableevents = true
         
         end if
         
 '============================='
         
  if not intersect(target, me.range("s9")) is nothing then

application.enableevents = false
  
  range("a1") = target.value
    
         application.enableevents = true
         end if
     
     
     end sub 

آیا میشه اطلاعات از سلول a1 به سلول b1 در شیت دیگه کپی بشه؟؟ کد vba باید چی نوشته بشه؟

[iranweld]

آیا میشه اطلاعات از سلول a1 به سلول b1 در شیت دیگه کپی بشه؟؟ کد vba باید چی نوشته بشه؟

اگر این خط دستور مد نظر شماست

 range("a1") = target.value 

از دستور
sheet2.range("b1") = target.value

[مجید ایرج]

اگر این خط دستور مد نظر شماست

 range("a1") = target.value 

از دستور
sheet2.range("b1") = target.value

با تشکر. اما اینجوری مشکلات من حل نمیشه. میشه آدرس اسکایپ بدید همونجا صوتی صحبت کنیم و راهنمایی بفرمایید؟ با تشکر

[مجید ایرج]

اگر این خط دستور مد نظر شماست

 range("a1") = target.value 

از دستور
sheet2.range("b1") = target.value

میشه بفرمایید توی این چند خط کدنویسی چجوری میشه سلول a1 و b1 رو تبدیل به کل رینج a و b گسترش داد؟؟

[مجید ایرج]

میشه بفرمایید توی این چند خط کدنویسی چجوری میشه سلول a1 و b1 رو تبدیل به کل رینج a و b گسترش داد؟؟

میشه بفرمایید توی این چند خط کدنویسی چجوری میشه سلول a1 و b1 رو تبدیل به کل رینج a و b گسترش داد؟؟

Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Range("B1") = Range("A1")
Application.EnableEvents = True
End Sub

[مجید ایرج]

اگر این خط دستور مد نظر شماست

 range("a1") = target.value 

از دستور
sheet2.range("b1") = target.value

میشه بفرمایید توی این چند خط کدنویسی چجوری میشه سلول a1 و b1 رو تبدیل به کل رینج a و b گسترش داد؟؟

Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Range("B1") = Range("A1")
Application.EnableEvents = True
End Sub

[iranweld]

با سلام

Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Me.Range("A:A")) Is Nothing Then

Application.EnableEvents = False

Target.Offset(0, 1) = Target

Application.EnableEvents = True

End If

End Sub 

[noroozzadeh]

با عرض سلام و ادب و کسب اجازه از اساتید
این کد را در رویداد change حل خواهد شد

Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As String
Application.EnableEvents = False
a = WorksheetFunction.CountA(Range("1:1"))
Range("A1").Offset(0, a) = Range("A1").Value
Application.EnableEvents = True
End Sub

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

[noroozzadeh]

این عکس رو هم گرفتم براتون

[noroozzadeh]

با سلام این کدی که فرستادم در صورتیکه در هرجای دیگر صفحه کاری انجام بدین باز هم اون دستور اجرا میشه و اگر میخواهید این اتفاق نیفته این کد رو جایگزین کنید .
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("A1") <> "" Then
Dim a As String
Application.EnableEvents = False
a = WorksheetFunction.CountA(Range("1:1"))
Range("A1").Offset(0, a) = Range("A1").Value
Range("A1") = ""
Application.EnableEvents = True
End If
End Sub

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

[مجید ایرج]

با سلام این کدی که فرستادم در صورتیکه در هرجای دیگر صفحه کاری انجام بدین باز هم اون دستور اجرا میشه و اگر میخواهید این اتفاق نیفته این کد رو جایگزین کنید .
Private sub worksheet_change(byval target as range)
if range("a1") <> "" then
dim a as string
application.enableevents = false
a = worksheetfunction.counta(range("1:1"))
range("a1").offset(0, a) = range("a1").value
range("a1") = ""
application.enableevents = true
end if
end sub

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

ضمن سلام و تشکر از شما دوست عزیز. متاسفانه این کد هم خواسته من رو برآورده نکرد. من نمیخوام a1 تخلیه بشه بلکه فقط کپی بشه و a1 پاک نشه. در عین حال زمانی که از توابع مقداری در a1 میشینه این کدهای ویژوال بیسیک به آخرین سلول خالی در همان ردیف منتقل بشه. در عین حال این قضیه برای کل رینج a صادق باشه و نه یک سلول a1. من الان حدود 2-3 ماه هست دنبال این کد هستم و تا این لحظه نتونستم به موفقیت برسم. اگر شما می تونید بنده رو راهنمایی کنید واقعا ممنونتون میشم

[noroozzadeh]

با عرض سلام
به راحتی با دو خط بیشتر کد میشود که این کد را برای تمام اکسل در کل ستون a1 گسترش داد ولی اینکه ستون a1 امکان ندارد چون در اثر هر حرکتی که در صفحه انجام بدین یک بار دیگر همان عدد که در سلول a هست بار دیگر به ردیف اضافه میشود ، حالا راههای زیر رو پیشنهاد میکنم
1- اگر عددهایی که در سلول مثلا a5 وارد میکنید هیچ وقت در همان ردیف تکراری نیست ، تنها در این صورت میشه خواسته شما رو برآورده کرد .
2- ستون a خالی باشد و ستون b همیشه آخرین عددی که در a وارد کردید رو نشان بده .
3- یک فرم وی بی روی شیت باز بشه و تمام کار در آن انجام بشه و صفحه فقط نقش بانک اطلاعاتی رو بازی کنه .
4-در جایی از صفحه یک دکمه قرار بدیم و هر وقت در a عدد جدیدی وارد کردید روی دکمه کلیک کنید تا عدد در اولین سلول خالی همون ردیفی که فوکوس هست ثبت بشه
5- کل توضیحات ردیف 4 انجام بشه ولی بجای افقی عمودی باشه
حالا هرکدام که میخواهید رو بفرمائیید انجام بدم