گری دو لیست در یک کاربرگ دارد. یکی از آنها، در ستون A، حاوی لیستی از اقلام مازاد شرکت ما و دیگری، در ستون G، حاوی لیستی از اسامی است. در ستون B:F چیزی وجود ندارد. گری میخواهد نامهایی را بهصورت تصادفی به فهرست موارد اختصاص دهد. هر نام از ستون G باید فقط یک بار اختصاص داده شود. اگر تعداد نامها بیشتر از موارد باشد، برخی از نامها استفاده نمیشوند. اگر تعداد نامهای کمتری نسبت به آیتمها وجود داشته باشد، برخی از آیتمها نام مرتبطی ندارند.
چند راه وجود دارد که می توان این کار را انجام داد. با این حال، شاید ساده ترین کار این باشد که به سادگی یک عدد تصادفی به هر مورد در ستون A اختصاص دهید. با فرض اینکه اولین مورد در سلول A1 است، موارد زیر را در سلول B1 قرار دهید:
=RAND()
روی دستگیره پر در سلول B1 دوبار کلیک کنید و در پایان باید یک عدد تصادفی (بین 0 و 1) در سمت راست هر مورد در ستون A داشته باشید.
اکنون، تمام سلول های ستون B را انتخاب کنید و Ctrl+C را فشار دهید تا آنها را در کلیپ بورد کپی کنید. از Paste Special برای چسباندن مقادیر به سلولهای ستون B استفاده کنید.
ستون های A و B را بر اساس مقادیر ستون B به ترتیب صعودی مرتب کنید. اگر به ردیف ها نگاه کنید، اکنون موارد (ستون A) به طور تصادفی با یک نام مرتبط می شوند (ستون G).
حتی اگر لازم نیست، میتوانید همین مراحل را دنبال کنید تا یک عدد تصادفی در سمت راست هر نام اضافه کنید و سپس نامها را مرتب کنید. (من می گویم که ضروری نیست زیرا تصادفی کردن موارد باید برای اطمینان از وجود موارد تصادفی مرتبط با هر نام کافی باشد.)
اگر مجبور باشید هر چند وقت یکبار جفتسازی تصادفی را انجام دهید، تکنیکی که تاکنون مورد بحث قرار گرفت، عالی عمل میکند. اگر لازم است این کار را اغلب انجام دهید، ممکن است یک ماکرو رویکرد بهتری باشد. البته، بسیاری از رویکردهای مبتنی بر کلان وجود دارد که می توانید از آنها استفاده کنید. رویکرد زیر فرض میکند که لیست آیتم در ستون A و لیست نام در ستون G است. همچنین فرض میکند که سلولهای سرصفحه در ردیف 1 برای هر ستون وجود دارد.
Sub AssignNames()
Set srItems = Range("A2").CurrentRegion
Set srNames = Range("G2").CurrentRegion
NameCount = srItems.Rows.Count - 1
ItemCount = srNames.Rows.Count - 1
Randomize Names
ReDim tempArray(NameCount, 2)
For x = 0 To NameCount - 1
tempArray(x, 0) = Range("G2").Offset(x, 0)
tempArray(x, 1) = Rnd()
Next x
Bubble Sort
For i = 0 To NameCount - 2
For j = i To NameCount - 1
If tempArray(i, 1) > tempArray(j, 1) Then
tempItem = tempArray(j, 0)
tempName = tempArray(j, 1)
tempArray(j, 0) = tempArray(i, 0)
tempArray(j, 1) = tempArray(i, 1)
tempArray(i, 0) = tempItem
tempArray(i, 1) = tempName
End If
Next j
Next i
AssignNames
Range("B2") = "Assigned"
AssignCount = NameCount
If NameCount > ItemCount Then AssignCount = ItemCount
For x = 0 To AssignCount
Range("B2").Offset(x, 0) = tempArray(x, 0)
Next x
End Sub
اگر تعداد نامها بیشتر از آیتمها باشد، ماکرو بهطور تصادفی نامها را به آیتمها اختصاص میدهد. اگر تعداد موارد بیش از نام باشد، به طور تصادفی برخی از آیتم ها را به نام ها اختصاص می دهد و به طور تصادفی "سوراخ" (اقلام بدون نام) را ترک می کند. آنها را در ستون B ذخیره میکند و هر آنچه را که در آنجا بود، بازنویسی میکند.