مشکل در تولید عدد تصادفی

**generalsamad** · 2015/05/15, 17:38

تشکر
فقط برای اینکه کد کامل بشه احتمال داره توی ستون b سلول خالی داشته باشیم
که میخوایم فقط سطرهایی که توی ستون b پر میشه همون سطرها توی ستون a عدد تصادفی تولید بشه
تشکر

**soosood** · 2015/05/15, 22:49

نوشته اصلی توسط علي پارسا

سلام،
کد امنيتي حتما" بايد تصادفي باشد؟ يا اگر فقط يکتا باشد کافي است؟ اين دو با هم خيلي تفاوت دارد، دومي راحت است ولي براي اولي بايد از کد نويسي و ماکرو استفاده کنيد،
شما با ماکرو ها آشنايي داريد؟
به فرض مثال کد زير در ستون A اعداد تصادفي 12 رقمي يکتا ايجاد مي کند البته اگر داده هايتان در جاي ديگري باشد بايد يک کم تغييرش دهيد، مي شود يک دگمه در صفحه قرار دهيد و اين کد را به آن نسبت داده و هر موقع خواستيد با فشرده دگمه کد مربوطه در آخرين خانه خالي ايجاد خواهد شد:

کد:

Private Sub CommandButton1_Click()
Dim C As Range
For Each C In Range("A:A")
If C = "" Then
C.Select
Exit For
End If
Next
Selection.Value = "=RANDBETWEEN(100000000000,999999999999)"
 Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("A:A").NumberFormat = "0"
    If Selection.Value = "" Then
    CommandButton1_Click
    Else
    Exit Sub
    End If
End Sub

ممنون دوست عزیز بابت وقتی که گذاشتید.
من با ماکرو ها آشنايي نداشتم ولی با زحمتی که کشیدید باعث شد کمی سرچ کنم.ابتدا برنامه اجرا نشد ولی با پاک کردن Private از اولش بنظرم درست شد .اصلا این Private چه کار میکنه؟ بازم ممنونم

**generalsamad** · 2015/05/15, 22:56

با سلام
اگه منظورتون این کد هست

کد PHP:


Private Sub CommandButton1_Click()

End Sub

این کد مربوط به شی دکمه (Button) و رویداد کلیک هست
این اشیا رو میتونید از تب Developer مشاهده کنید

**Ali Parsaei** · 2015/05/16, 00:56

نوشته اصلی توسط generalsamad

تشکر
فقط برای اینکه کد کامل بشه احتمال داره توی ستون b سلول خالی داشته باشیم
که میخوایم فقط سطرهایی که توی ستون b پر میشه همون سطرها توی ستون a عدد تصادفی تولید بشه
تشکر

خوب مي شود گفت به نوعي اين يک مسئله جديد مي باشد و شرايطش کلا" فرق مي کند، براي اين منظور مي توان از کد زير استفاده کرد:

کد PHP:


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
FIRST:
Dim C As Range
For Each C In Range("A1:A15")
If C.Offset(0, 1) <> "" And C = "" Then
C.Select
Selection.Value = "=RANDBETWEEN(1,15)"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Dim D As Integer
D = ActiveCell.Row
If WorksheetFunction.CountIf(Range("A1:A15"), Cells(D, 1)) > 1 Then
ActiveCell.Value = ""
GoTo FIRST
End If
End If
Next
End Sub

**Ali Parsaei** · 2015/05/16, 01:12

نوشته اصلی توسط soosood

ممنون دوست عزیز بابت وقتی که گذاشتید.
من با ماکرو ها آشنايي نداشتم ولی با زحمتی که کشیدید باعث شد کمی سرچ کنم.ابتدا برنامه اجرا نشد ولی با پاک کردن Private از اولش بنظرم درست شد .اصلا این Private چه کار میکنه؟ بازم ممنونم

همانطور که دوستمان جناب GENERALSAMAD فرموده اند خط ابتدا و انتهايي کد مربوط به اجراي آن با يک دگمه است، ولي اجراي آن با ماکرو فرق مي کند. اگر شما آن را بخواهيد با ماکرو اجرا کنيد خط آخر (End Sub) تغيير نخواهد کرد ولي خط اول را بايد تغيير دهيد مثلا" اگر شماره ماکرو شما "يک" باشد بايد کد را با عبارت ()Sub Macro1 شروع کنيد در اين صورت با هر بار اجراي ماکرو يک عدد تصادفي ايجاد خواهد شد.

**soosood** · 2015/05/16, 01:45

نوشته اصلی توسط علي پارسا

همانطور که دوستمان جناب GENERALSAMAD فرموده اند خط ابتدا و انتهايي کد مربوط به اجراي آن با يک دگمه است، ولي اجراي آن با ماکرو فرق مي کند. اگر شما آن را بخواهيد با ماکرو اجرا کنيد خط آخر (End Sub) تغيير نخواهد کرد ولي خط اول را بايد تغيير دهيد مثلا" اگر شماره ماکرو شما "يک" باشد بايد کد را با عبارت ()Sub Macro1 شروع کنيد در اين صورت با هر بار اجراي ماکرو يک عدد تصادفي ايجاد خواهد شد.

مرسی از پاسخ شما ولی به یک مشکل برخوردم و اون اینکه وقتی protect sheet میکنم از کدها ایراد run-time error 1004 میگیره.حالا چطور میتونم protect sheet کنم؟

**Ali Parsaei** · 2015/05/16, 02:04

نوشته اصلی توسط soosood

مرسی از پاسخ شما ولی به یک مشکل برخوردم و اون اینکه وقتی protect sheet میکنم از کدها ایراد run-time error 1004 میگیره.حالا چطور میتونم protect sheet کنم؟

با رمز protect مي کنيد و يا بدون رمز؟ آخه بعضي مواقع کاربران بدون رمز هم protect مي کنند (صرفا" به خاطر اينکه يک وقت اشتباها" خودشان چيزي را ناخواسته تغيير ندهند)
بايد ابتداي کد يک خط براي باز کردن قفل و آخر کد يک خط براي قفل مجدد شيت اضافه کنيد (درخط دوم و خط يکي مانده به آخر)
"ActiveSheet.Unprotect "123 براي باز کردن است، البته بايد به جاي 123 رمز خودتان را بنويسيد و اگر بدون رمز قفل مي کنيد فقط بنويسيد: ActiveSheet.Unprotect
و در آخر کد هم بنويسيد "ActiveSheet.protect "123 و يا اگر رمز ندارد: ActiveSheet.protect
البته اون وقت بهتر است براي قسمت vba فايل اکسل مورد نظرتان هم رمز گذاري کنيد وگرنه کاربران وارد با مراجعه به آن قسمت رمزتان را خواهند يافت.

**soosood** · 2015/05/17, 23:39

نوشته اصلی توسط علي پارسا

با رمز protect مي کنيد و يا بدون رمز؟ آخه بعضي مواقع کاربران بدون رمز هم protect مي کنند (صرفا" به خاطر اينکه يک وقت اشتباها" خودشان چيزي را ناخواسته تغيير ندهند)
بايد ابتداي کد يک خط براي باز کردن قفل و آخر کد يک خط براي قفل مجدد شيت اضافه کنيد (درخط دوم و خط يکي مانده به آخر)
"ActiveSheet.Unprotect "123 براي باز کردن است، البته بايد به جاي 123 رمز خودتان را بنويسيد و اگر بدون رمز قفل مي کنيد فقط بنويسيد: ActiveSheet.Unprotect
و در آخر کد هم بنويسيد "ActiveSheet.protect "123 و يا اگر رمز ندارد: ActiveSheet.protect
البته اون وقت بهتر است براي قسمت vba فايل اکسل مورد نظرتان هم رمز گذاري کنيد وگرنه کاربران وارد با مراجعه به آن قسمت رمزتان را خواهند يافت.

ممنون از راهنمایی شما .این کدها رو اضافه کردم عمل میکنه ولی دیگه شیت رو protect نمیکنه !به نظر میرسه کدی که باید دوباره قفلش کنه و در خط یکی مانده به آخر اضافه میشه عمل نمیکنه.
مرسی از توجه شما

**generalsamad** · 2015/05/17, 23:55

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

کد PHP:


ActiveSheet.Unprotect "123"

کد PHP:


ActiveSheet.Protect "123"

**soosood** · 2015/05/17, 23:56

کد ها روبه این صورت اضافه کردم

فایل های پیوست شده

**soosood** · 2015/05/18, 00:09

نوشته اصلی توسط generalsamad

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

کد PHP:


ActiveSheet.Unprotect "123"

کد PHP:


ActiveSheet.Protect "123"

بله مطابق عکسی که پیوست کردم

**Ali Parsaei** · 2015/05/18, 00:53

نوشته اصلی توسط soosood

ممنون از راهنمایی شما .این کدها رو اضافه کردم عمل میکنه ولی دیگه شیت رو protect نمیکنه !به نظر میرسه کدی که باید دوباره قفلش کنه و در خط یکی مانده به آخر اضافه میشه عمل نمیکنه.
مرسی از توجه شما

بله حق با شما است، من عذرخواهي مي کنم، اون رو به خط يکي مانده به آخر نبايد اضافه کنيد بلکه بايد بعد از خطي که نوشته: "Range("A:A").NumberFormat = "0 اضافه کنيد.
باز اگر مشکلي داشت بفرماييد تا بررسي شود.

**soosood** · 2015/05/18, 21:56

نوشته اصلی توسط علي پارسا

بله حق با شما است، من عذرخواهي مي کنم، اون رو به خط يکي مانده به آخر نبايد اضافه کنيد بلکه بايد بعد از خطي که نوشته: "Range("A:A").NumberFormat = "0 اضافه کنيد.
باز اگر مشکلي داشت بفرماييد تا بررسي شود.

ممنون دوست عزیز همه چیز درست شد.لطف کردین