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

**nikkhah** · 2015/05/12, 21:36

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

تولید اعداد تصادفی با طول دلخواه و ثابت

باز هم اگر سوالی بود مطرح بفرمایید .

**generalsamad** · 2015/05/13, 01:38

با سلام
فکر کنم مسله شما نیاز به یک کد داره که وقتیعدد تصادفی تولید میکنه اونو تبدیل به Value کنه که اون عدد تصادفی تغییر نکنه علاوه بر تبدیل اون عدد به Value، این عدد تصادفی باید منحصر به فرد (uniq) هم باشه

**iranweld** · 2015/05/13, 10:12

با سلام
شما میتوانید یا در یک شیت دیگر به تعداد مورد نیاز عدد رندوم تولید نموده و هر بار بصورت رندم یکی را انتخاب کنید یا بایستی عدد رندم تولید شده در فرمول خود را ابتدا copy و سپس با past special و انتخاب value پیست نمایید تا عدد ثابت بماند.

**soosood** · 2015/05/13, 13:13

درسته دوست من یه همچین چیزی لازم دارم . حالا چه کسی میتونه کدش رو بده ؟!

**soosood** · 2015/05/13, 13:15

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

با سلام
فکر کنم مسله شما نیاز به یک کد داره که وقتیعدد تصادفی تولید میکنه اونو تبدیل به Value کنه که اون عدد تصادفی تغییر نکنه علاوه بر تبدیل اون عدد به Value، این عدد تصادفی باید منحصر به فرد (uniq) هم باشه

درسته دوست من یه همچین چیزی لازم دارم . حالا چه کسی میتونه کدش رو بده ؟!

**iranweld** · 2015/05/13, 13:35

عدد رندم تولید شده در فرمول خود را ابتدا copy و سپس با past special و انتخاب value پیست نمایید تا عدد ثابت بماند.

**soosood** · 2015/05/13, 17:27

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

عدد رندم تولید شده در فرمول خود را ابتدا copy و سپس با past special و انتخاب value پیست نمایید تا عدد ثابت بماند.

ممنون از راهنمایی شما ولی این عدد نمیخواهم تکراری باشه.شما در نظر بگیرید وقتی مثلا 30تا ردیف که پر شد چطوری کنترل کنم که تکراری نباشه.ضمنا می خواهم تا آنجا که میشه این کار بصورت اتوماتیک انجام بشه .نه اینکه یه شیت پراز عدد تصادفی ایجاد کنم بعدش برای هر ردیف یه مرتبه عدد رو کپی و پیست کنم.چون ممکنه این کار توسط یک اپراتور دیگه انجام بشه و دقت لازم را نداشته باشه.باز هم ممنون

**soosood** · 2015/05/14, 13:39

از اساتید کسی نمیتونه کمک کنه !؟

**iranweld** · 2015/05/14, 14:20

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

از اساتید کسی نمیتونه کمک کنه !؟

سلام
یک فایل تهیه گردیده که بایستی در یک شیت جداگانه از آن استفاده نمایید عدد تصادفی تولید شده را در یک ستون دیگر لیست مینماید و در صورت تکراری بودن بصورت رنگی مشخص میگردد و شما عدد تصادفی جدید را محل مورد نظر کپی مینماید
فقط بعد از دانلود فایل، پسوند فایل را xlsm نمایید سایت با آپلود فایلهای دارای ماکرو مشکل داره

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

عدد رندم غیر تکر&#.xls (46.2 کیلو بایت, مشاهدات 12)

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

سلام،
کد امنيتي حتما" بايد تصادفي باشد؟ يا اگر فقط يکتا باشد کافي است؟ اين دو با هم خيلي تفاوت دارد، دومي راحت است ولي براي اولي بايد از کد نويسي و ماکرو استفاده کنيد،
شما با ماکرو ها آشنايي داريد؟
به فرض مثال کد زير در ستون 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

**generalsamad** · 2015/05/15, 13:58

با سلام
چه کدی باید به کد بالا اضافه کنیم که وقتی تعداد اعداد تصادفی تمام شد از حلقه خارج بشه (for exit)
ممنون

**Ali Parsaei** · 2015/05/15, 14:15

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

با سلام
چه کدی باید به کد بالا اضافه کنیم که وقتی تعداد اعداد تصادفی تمام شد از حلقه خارج بشه (for exit)
ممنون

مثلا" بايد تعداد خانه هاي متغيير C که A:A نوشته شده دقيقا" به اندازه همان محدوده تابع RANDBETWEEN تعيين گردد.
در اين صورت وقتي به خانه آخر محدوده رسيد اگر دوباره دگمه را فشار دهيد صرفا" يک بار عمليات براي خانه آخر تکرار مي شود. البته نتيجه خانه آخر تغيير نخواهد کرد زيرا فقط يک عدد مانده که مي شود در آن جاي داد و بقيه اعداد در خانه هاي بالاتر استفاده شده.
براي امتحان درستي مطلب فوق مي توانيد کد بالا را براي خانه هاي A1:A15 به صورت زير تغيير داده و امتحان کنيد:

کد:

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

البته فکر کنم دوستان کدهاي خيلي حرفه اي تري مي توانند ارائه دهند، من صرفا" VBA را به صورت تجربي ياد گرفته ام به همين خاطر خيلي هم کدهايم حرفه اي نيست

**generalsamad** · 2015/05/15, 14:25

تشکر
یه سوال دیگه
اگه بخوایم این کد رو روی دکمه اعمال نکنیم
مثلا کد طوری باشه که اگه سطر متناظر ستون b پر شد توی سطر متناظر توی ستون a عدد تصادفی وارد شه
که نیازی نباشه دکمه ای بسازیم
و عمل تولید عدد تصادفی بر اساس ستون b باشه
بطور مثال اگه توی سلول B1 مقداری ثبت شد سلول A1 عدد تصادفی تولید کنه
با تشکر

**Ali Parsaei** · 2015/05/15, 17:32

اون وقت بايد تو رويداد SELECTION_CHANGE شيت کد را بنويسيم، يک همچين چيزي مي شود: (امتحان کنيد ببينيد درست نوشته ام و کار مي کند؟)
توضيح اينکه روال کار را اول به نام FIRST نام گذاري کرده ام و در آخر گفته ام: اگر REMOVE DUPLICATE انجام شد و خانه فعال خالي ماند (يعني مقدارش تکراري بود و حذف شد) دوباره FIRST را اجرا کند:

کد:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
FIRST:
Dim C As Range
For Each C In Range("A1:A15")
If C = "" And C.Offset(0, 1).Value <> "" Then
C = "=RANDBETWEEN(1,15)"
C.Select
 Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Range("A1:A15").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("A1:A15").NumberFormat = "0"
    If Selection.Value = "" Then
    GoTo FIRST
    End If
    Exit For
    End If
    Next
End Sub

ضمنا" اون خط که راجع به فرمت مي باشد را صرفا" براي اين گذاشته ام که در کامپيوتر من بعضي مواقع بعد از REMOVE DUPLICATE فرمت سل عوض مي شد و عدد هاي 12 رقمي را به صورت علمي (مثلا" 2.34356E+12) مي نوشت و خواستم اين مشکل بوجود نيايد (اگر يادتان باشد فرمول اول را براي عددهاي 12 رقمي نوشته بودم)