قفل کردن فایل اکسل [بایگانی]

مجید ایرج

2015/12/03, 21:19

با عرض سلام. بنده دو تا مشکل دارم و به شدت نیاز به راهنمایی دارم. میخوام توی یک سلول تابعی بنویسم که مقداری رو بدست بیاره و توی سلول دیگه ای که هیچ تابعی نباید داخلش نوشته بشه ارجاع بده. مثلا در سلول a1 مقداری رو محاسبه کنه و در b1 که هیچ تابعی نداره نتیجه رو بیاره. دوم اینکه میخوام علاوه بر اینکه کاربرگها قفل داشته باشن(برای این قسمت مشکلی ندارم)، کل فایل اکسل هم برای باز شدن نیاز به قفل شدن داشته باشه

Ali Parsaei

2015/12/03, 21:38

سلام،
تابع در a1 نوشته مي شود و نتيجه در آن به دست مي آيد، اگر مي خواهيد در b1 نتيجه درج گردد، بايد در آن بنويسيد: A1= اگر اين را هم نخواهيد بنويسيد و b1 خالي خالي باشد و فقط مقدار نتيجه در آن درج گردد چنين چيزي امکان ندارد مگر با کد نويسي بوسيله vba که البته دنگ و فنگ مخصوص به خود را دارد.
براي رمز گذاري روي فايل بايد يک save as از آن بگيريد و در همان پنجره save as گزينه tools را پيدا کرده و مثلث کنارش را کليک کرده و گزينه general option را انتخاب کنيد.
ضمنا" لطفا" براي سوالات خود نام مناسب انتخاب کنيد به نحوي که با خواندن تيتر سوال تا اندازه اي بتوان کليت آن را فهميد و در ضمن سوالاتتان را در تالارهاي مناسب ايجاد کنيد. (قسمت "مشکلات کاربري" مخصوص مشکلات در مورد کار در سايت و انجمن است)

مجید ایرج

2015/12/03, 22:45

سلام،
تابع در a1 نوشته مي شود و نتيجه در آن به دست مي آيد، اگر مي خواهيد در b1 نتيجه درج گردد، بايد در آن بنويسيد: A1= اگر اين را هم نخواهيد بنويسيد و b1 خالي خالي باشد و فقط مقدار نتيجه در آن درج گردد چنين چيزي امکان ندارد مگر با کد نويسي بوسيله vba که البته دنگ و فنگ مخصوص به خود را دارد.
براي رمز گذاري روي فايل بايد يک save as از آن بگيريد و در همان پنجره save as گزينه tools را پيدا کرده و مثلث کنارش را کليک کرده و گزينه general option را انتخاب کنيد.
ضمنا" لطفا" براي سوالات خود نام مناسب انتخاب کنيد به نحوي که با خواندن تيتر سوال تا اندازه اي بتوان کليت آن را فهميد و در ضمن سوالاتتان را در تالارهاي مناسب ايجاد کنيد. (قسمت "مشکلات کاربري" مخصوص مشکلات در مورد کار در سايت و انجمن است)

با تشکر از شما. آیا مطمئن هستید که هیچ تابعی برای این کار وجود نداره؟ آیا نمیشه با تابعی آدرس یک سلول را داد تا نتیجه در آن سلول درج بشه؟؟ این موضوع ماه هاست من رو درگیر خودش کرده. آیا تابع offset در این زمینه به ما کمک نمیکنه؟

Ali Parsaei

2015/12/03, 23:27

به هيچ عنوان چنين تابعي وجود ندارد 100٪ مطمئن باشيد.

مجید ایرج

2015/12/04, 00:53

در بعضی فایل ها دیدم که قسمتی برای کلیک کردن وجود داره که باعث میشه اطلاعات انتقال پیدا کنه. میتونید بگید از چه توابعی استفاده شده و چطوریه؟ یک نمونه براتون میذارم نگاه کنید
http://uploadboy.me/df0f3wwyvv4l/گزارش توليد.xlsm

iranweld

2015/12/04, 01:02

در فایل پیوست در صورت تغییر در سلولهای ستونA مقدار آن در ستون B درج میگردد

کدهای ذیل را در قسمت کدنویسی شیت مورد نظر وارد کنید

Sub Worksheet_Change(ByVal Target As Range)

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

Target.Offset(0, 1).Value = Target.Value

End If

End Sub

مجید ایرج

2015/12/04, 19:25

در فایل پیوست در صورت تغییر در سلولهای ستونA مقدار آن در ستون B درج میگردد

کدهای ذیل را در قسمت کدنویسی شیت مورد نظر وارد کنید

Sub Worksheet_Change(ByVal Target As Range)

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

Target.Offset(0, 1).Value = Target.Value

End If

End Sub

ممنون ازتون. من از کدنویسی هیچی نمیدونم. میشه توضیح بدی چجوری اینکارو انجام بدم؟ فقط developer رو آوردم. حالا چیکار کنم؟ چجوری فقط روی یک شیت اجراش کنم؟

مجید ایرج

2015/12/04, 19:32

در فایل پیوست در صورت تغییر در سلولهای ستونA مقدار آن در ستون B درج میگردد

کدهای ذیل را در قسمت کدنویسی شیت مورد نظر وارد کنید

Sub Worksheet_Change(ByVal Target As Range)

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

Target.Offset(0, 1).Value = Target.Value

End If

End Sub

ممنون ازتون. من از کدنویسی هیچی نمیدونم. میشه توضیح بدی چجوری اینکارو انجام بدم؟ فقط developer رو آوردم. حالا چیکار کنم؟ چجوری فقط روی یک شیت اجراش کنم؟

مجید ایرج

2015/12/04, 21:38

من از این کد تونستم استفاده کنم. اما متاسفانه اصلا پویا نیست. یعنی اگر a1 با هر تابعی (مثلا index) مقدارش رو از یک سلول دیگه بگیره دیگه این کد کار نمیکنه. باید چیکار کرد؟

abootorab

2015/12/05, 00:22

من از این کد تونستم استفاده کنم. اما متاسفانه اصلا پویا نیست. یعنی اگر a1 با هر تابعی (مثلا index) مقدارش رو از یک سلول دیگه بگیره دیگه این کد کار نمیکنه. باید چیکار کرد؟

با درود و تشکر از جناب iranweld
دوست عزیز کد رو بصورت زیر تغییر دهید: (در صورتیکه سلولهای مورد نظرتون غیر A1 و B1 باشند در کد زیر متناظر آنها را جایگزین کنید)

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

البته با توجه به خواسته ای که بیان کرده اید به راحتی با نوشتن فرمول زیر در سلول B1 به هدفتون برسید، اما اگر به هر دلیلی نمیخواین درون سلول B1 فرمول و یا تابعی وجود داشته باشد از کد فوق استفاده کنید.

=A1

مجید ایرج

2015/12/12, 09:55

در فایل پیوست در صورت تغییر در سلولهای ستونA مقدار آن در ستون B درج میگردد

کدهای ذیل را در قسمت کدنویسی شیت مورد نظر وارد کنید

Sub Worksheet_Change(ByVal Target As Range)

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

Target.Offset(0, 1).Value = Target.Value

End If

End Sub

کدی که دوستمون abootorab (http://forum.exceliran.com/member.php/18623-abootorab) گفت کار نکرد. حالا یک سوال دارم. همین کدی که شما دادید اگر بخواداینطوری باشه چکار باید کرد؟ :
مثلا A1 رو توی B1 بنویسه. اگر B1 نوشته داشت توی E1بنویسه و اگر E1 هم نوشته داشت بره توی H1 بنویسه و این روند تا مثلا ZZ1 ادامه داشته باشه. یعنی اینکه هر بار توی چندتا سلول جلوتر بنویسه
راجع به سوال قبلی هم اینکه چطور پویا کنمش؟؟ راه حلی هست؟ ممنون از راهنماییاتون

iranweld

2015/12/12, 10:53

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

Sub Worksheet_Change(ByVal Target As Range)

'============ÈÑÇí ÓÊæä A====='

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

Application.EnableEvents = False

Target.Offset(0, 1).Value = Target.Value

Application.EnableEvents = True

End If

'=======================ÈÑÇí ÓÊæä C======='

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

Application.EnableEvents = False

Target.Offset(0, 2).Value = Target.Value

Application.EnableEvents = True

End If

'=======================ÈÑÇí ÓÊæä F====='

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

Application.EnableEvents = False

Target.Offset(0, 3).Value = Target.Value

Application.EnableEvents = True

End If

End Sub

مجید ایرج

2015/12/14, 20:03

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

sub worksheet_change(byval target as range)

'============èñçí óêæä a====='

if not intersect(target, me.range("a:a")) is nothing then

application.enableevents = false

target.offset(0, 1).value = target.value

application.enableevents = true

end if

'=======================èñçí óêæä c======='

if not intersect(target, me.range("c:c")) is nothing then

application.enableevents = false

target.offset(0, 2).value = target.value

application.enableevents = true

end if

'=======================èñçí óêæä f====='

if not intersect(target, me.range("f:f")) is nothing then

application.enableevents = false

target.offset(0, 3).value = target.value

application.enableevents = true

end if

end sub

ممنون ازتون. اما منظورم این نبود. من میخوام همیشه در ستوان َ بنویسم نه در ستون دیگه. بعد اطلاعات از a به b کپی بشه، دفعه بعد که توی a چیزی نوشم توی c کپی بشه بدون اینکه به B دست بخوره. و این روند ادامه داشته باشه تا z. بازم ممنون از راهنماییهاتون

iranweld

2015/12/14, 21:40

با سلام

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

Sub Worksheet_Change(ByVal Target As Range)

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

I=target.row

K = ActiveSheet.Cells(I, Columns.Count).End(xlToLeft).Column

Target.Offset(0, K).Value = Target.Value

End If

End Sub

مجید ایرج

2015/12/18, 09:04

با سلام

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

sub worksheet_change(byval target as range)

if not intersect(target, me.range("a:a")) is nothing then

i=target.row

k = activesheet.cells(i, columns.count).end(xltoleft).column

target.offset(0, k).value = target.value

end if

end sub

خیلی خیلی ممنون. فقط دو تا ایراد بزرگ در استفاده ازش وجود داره. اول اینکه من میخوام مثلا اگر در a1 رو نوشتم در b1 نوشته بشه و اگر b1 نوشته داشت داخل c1 نوشته بشه (مثل همون چیزی که قبلا گفتم). فقط میخوام این موضوع مثلا تا e1 محدود باشه و زمانی که توی f1 نوشتم همون روند قبلی برای سلولهای بعدی اجرا بشه. یعنی از a تا f یک مجموعه باشه و از f تا مثلا n یک مجموعه باشه. و اما مشکل دوم اینکه این روش اصلا پویا نیست. مثلا من میخوام a1 رو مساوی s9 قرار بدم و هر زمان که توی s9 نوشتم توی a1 با همون روابط ساده اکسل نوشته باشه. اما زمانی که از این توابط استفاده میشه دیگه این کدنویسی شما عمل نمیکنه. اگر این دو مورد رو راهنمایی بفرمایید ممنونتون می شم

مجید ایرج

2016/01/23, 00:37

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

iranweld

2016/01/24, 08:18

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

با سلام

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

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

مجید ایرج

2016/01/24, 10:49

جناب iranweld (http://forum.exceliran.com/member.php/23192-iranweld) امکانش هست از طریق اسکایپ باهم صحبت کنیم تا مشکلم حل بشه؟؟ با تشکر

مجید ایرج

2016/01/24, 23:14

با سلام

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

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

2016/01/25, 09:04

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

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

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

مجید ایرج

2016/01/25, 19:14

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

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

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

مجید ایرج

2016/01/25, 20:35

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

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

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

مجید ایرج

2016/01/26, 10:42

میشه بفرمایید توی این چند خط کدنویسی چجوری میشه سلول 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

مجید ایرج

2016/01/26, 17:41

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

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

2016/01/28, 06:27

با سلام

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

2016/02/02, 16:12

با عرض سلام و ادب و کسب اجازه از اساتید
این کد را در رویداد 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

2016/02/02, 16:47

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

noroozzadeh

2016/02/02, 16:57

با سلام این کدی که فرستادم در صورتیکه در هرجای دیگر صفحه کاری انجام بدین باز هم اون دستور اجرا میشه و اگر میخواهید این اتفاق نیفته این کد رو جایگزین کنید .
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 تخلیه میشه

مجید ایرج

2016/02/03, 23:02

با سلام این کدی که فرستادم در صورتیکه در هرجای دیگر صفحه کاری انجام بدین باز هم اون دستور اجرا میشه و اگر میخواهید این اتفاق نیفته این کد رو جایگزین کنید .
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

2016/02/04, 20:10

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

noroozzadeh

2016/02/04, 20:12

منظورم از خط اول خالی نشدن سلول a بود

مجید ایرج

2016/02/07, 22:31

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

خیلی جاها دقیق منظورتون رو متوجه نشدم. این از بدی های چت هست. آیا امکانش هست از طریق اسکایپ با شما صحبت کنم تا بتونم بهتر کمک بگیرم؟؟ مورد چهارم که گفتید دکمه ثبت جوابگوی کار من نیست چون من عملیاتم برای مثلا 500 ردیف هست و هربار با زدن دکمه ثبت کل این 500 مورد ثبت میشه در حالیکه من شاید قبلا برای 499 تاشون این کار رو انجام داده باشم اما در کل برای یک قسمت دیگه از اجرای برنامه به این دکمه ثبت نیاز دارم و اگر جدا در اختیارم بذارید ممنون میشم. به نظر میرسه راهکار 1 مناسب کار من باشه بازم باید مطمئن بشم چون دقیق متوجه نشدم. من میخوام غیر تکراری ها ثبت بشه و نه تکراری ها. من یوزر اسکایپ و شمارمو براتون با پیغام خصوصی میفرستم و منتظر خبرتون هستم تا از طریق اسکایپ صحبت کنیم. با تشکر از شما دوست عزیز