![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?e8efa67)
A 回答 (5件)
- 最新から表示
- 回答順に表示
No.5
- 回答日時:
コードを乗せていきます。
Option Explicit
Option Base 0
Const Base = 0 _
, 人数 = 18 _
, 表示行数 = 6 _
, 従業員記載列数 = 1 _
, 縦表示開始位置 = 3 _
, 横表示開始位置 = 5
Const ファーストNo. = Base + 1 _
, Eof = Base - 1 _
, 右手 = Base + 1 _
, 左手 = Base + 2 _
, 実態 = Base + 0
Const 触手数 = 3 + Base - ファーストNo.
Function 間乱数(ByVal Val1 As Long, ByVal Val2 As Long) As Long
間乱数 = Evaluate("RANDBETWEEN(" & Val1 & "," & Val2 & ")")
End Function
Function 方形数(ByVal Val1 As Long, ByVal Val2 As Long) As Long
方形数 = Evaluate("Ceiling(" & Val1 & "," & Val2 & ")")
End Function
Function 方形辺(ByVal Val1 As Long, ByVal Val2 As Long) As Long
方形辺 = 方形数(Val1, Val2) / Val2 '
End Function
Function 桁上り(ByVal Val1 As Long, ByVal Val2 As Long) As Long
桁上り = Fix(CDbl(Val1) / CDbl(Val2))
End Function
Sub Main()
Dim ポインタ1 As Long, カウンタ1 As Long, カウンタ2 As Long, ターゲット As Long, 総データ量 As Long
Dim データ残量 As Long, メッセージ As String, BadEnd As Boolean, 名前リスト As Range, 輪留め As Long
Dim 実データ() As String, データリンク() As Long, スプール() As String, このブック As Workbook, しーと As String
BadEnd = False
Set このブック = ThisWorkbook
しーと = ThisCell.Worksheet.Name
メッセージ = "正常終了"
Set 名前リスト = このブック.Sheets(しーと).Range("A3").CurrentRegion.Resize(, 従業員記載列数)
If 名前リスト.Count < 人数 _
Then
メッセージ = "職員名簿に不備があります"
BadEnd = True
Else
総データ量 = 名前リスト.Count
輪留め = 総データ量 + 1
ReDim 実データ(ファーストNo. To Base + 総データ量)
ReDim データリンク(Base To Base + 触手数, Base To Base + 輪留め)
ReDim スプール(ファーストNo. To Base + 方形数(人数, 表示行数))
For カウンタ1 = ファーストNo. To 総データ量
実データ(カウンタ1) = CStr(名前リスト(カウンタ1).Value)
データリンク(実態, カウンタ1) = カウンタ1
データリンク(右手, カウンタ1) = カウンタ1 + 1
データリンク(左手, カウンタ1) = カウンタ1 - 1
Next カウンタ1
データリンク(右手, 輪留め) = Eof
データリンク(実態, 輪留め) = Eof
データリンク(右手, Base) = ファーストNo.
データ残量 = 総データ量
For カウンタ2 = ファーストNo. To 人数
ターゲット = 間乱数(1, データ残量)
' Debug.Print データ残量 & " " & ターゲット & " " & カウンタ3
カウンタ1 = Base
ポインタ1 = Base
Do
ポインタ1 = データリンク(右手, ポインタ1)
カウンタ1 = カウンタ1 + 1
If データリンク(右手, ポインタ1) <= Eof Or カウンタ1 > データ残量 _
Or データリンク(右手, Base) <= Eof Or データ残量 < 1 _
Then
BadEnd = True
End If
Loop Until カウンタ1 >= ターゲット Or BadEnd
If Not BadEnd _
Then
'メンバを取り出しリンクから外す。
' データを読出した後に、
' ポインタメンバー左手側のメンバーの右手に、ポインタメンバーの右手側のメンバーを掴ませ、
' ポインタメンバー右手側のメンバーの左手に、ポインタメンバーの左手側のメンバーを掴ませ
' リンケージを再構築する
If 実データ(データリンク(実態, ポインタ1)) = "" Then MsgBox ("げ!!")
スプール(カウンタ2) = 実データ(データリンク(実態, ポインタ1))
データリンク(左手, データリンク(右手, ポインタ1)) = データリンク(左手, ポインタ1)
データリンク(右手, データリンク(左手, ポインタ1)) = データリンク(右手, ポインタ1)
データリンク(左手, ポインタ1) = Eof
データリンク(右手, ポインタ1) = Eof
データリンク(実態, ポインタ1) = Eof
データ残量 = データ残量 - 1
Else
メッセージ = "BadEnd"
Exit For
End If
Next カウンタ2
If Not BadEnd _
Then
For カウンタ1 = ファーストNo. To 方形数(人数, 表示行数)
このブック.Sheets(しーと).Cells _
(縦表示開始位置 + (カウンタ1 - 1) Mod 表示行数 _
, 横表示開始位置 + 桁上り(カウンタ1 - 1, 表示行数)).Value _
= スプール(カウンタ1)
Next カウンタ1
End If
End If
MsgBox (メッセージ)
End Sub
SpecialThanks
cj_mover 様
mt2008 様
No.4
- 回答日時:
お待たせしました、
関数式では、今一上手くいきませんでしたが
VBAでは上手くいきました。
1PPMの精度を、
と、考えたのですが
どうやら40時間位掛かりそうなので、
5000回回して確認しました。
まあもう2度と同じ名前が出ることはないでしょう…
そういう構造ですから。
コード公開すべきか考えたのですが、
まあいいでしょう。
使い方ですが
まず第1にお願いすべきは
ファイルを開く時に
マクロを有効化することに同意頂くことでしょう。
VBAが入っていることが前提ですので、
これは此方からではどうにも避けられません。
其方の設定次第では 問答無用で
「VBAをOK」
と、できるのですが、
これは私からお願いできることではありませんし、
お勧めできません。
次には
B列に何も書かないで欲しい
と、云うことです。
書いてしまうと
結果に空欄が出ます。
後は、
A列に名簿を
縦に好きなだけ書いてください、
但し
重複すると、結果も重複しかねません。
氏名以外を書くと、それが選び出されかねません。
お気をつけを…
ファイルを
http://sdrv.ms/11Skw4K
に、置いておきました。
このままではVBAが動きませんので
ダウンロードしてお使いください。
ダウンロード後、開くと
シート名「VBA」に、ボタンらしきものが置いてあります。
「しゃっふろ」と書いてあります。
これを「ぽち」っとクリックすると
名簿の人数が足りていたら、その中から18名選び出して
一覧で表示してくれます。
VBEでみれるなら、
縦方向の折り返し幅も
法事開始位置も、選び出す人数も、名簿に使える列数も、
全て定数で設定しておりますので、
この辺りを無難な範囲で変えて頂くと
思いのままになると思います。
著作権を謳う程のものか解らないですが、
一様著作権は放棄しませんので、
定数を変える程度より以上の
改変や流用はお控えください。
まあシート名を変えたり、ブック名を変えたりする分には良いですけどね、
これを使えば
カードゲームでのカードのシャッフルなんてお手の物
名簿にカードの種類を書いて一覧にして、選び出す定数、1列に何件出すか、全部で何件出すか、
を変えれば、大凡どんなゲームでも札が撒けるでしょう。
そもそも
私が最初にこれを作ったのが
カードゲーム用のシャッフル&配布の一部、
それの非常に簡易版なのですから。
でも、
使っちゃやですよ。
お使い頂ける範囲は
・貴方限定、・この業務限定、・この用途限定です。
コードの構造を知ったからと云って、
それも使わないでくださいね、
使うのは
その質問をして、答えを得た時だけ
に、してくださいね。
振りを振っている訳じゃないですよ、
マジ駄目ですからね。
コードも書こうと思いましたが文字数足らず、 Orz
如何でしょうか?
お役に立てていたならば幸いです。
No.3
- 回答日時:
質問させてください
愚問かも知れませんが、
挙げられている中では「名前」が18回上がっているように思います。
質問からすると
18名以上の人物が居て、その内の18名が、一切被ることなく出現する。
と、云うことを目指されているのでしょうか?
VBAで実現できなくもないですが、私の力では時間が掛かりそうですね、
取りあえず関数式なら、もっと早くできそうなのですが、
反復計算になっても構わないでしょうか?
補足をお待ちしております。
No.2
- 回答日時:
No.1 です。
一つ大事なことを書き忘れたので、補足します。RAND 関数は、再計算のたびに異なる値を返すので、その度に、名前の配置が入れ替わることになります。これを固定するには、G1:I6 のセル範囲をどこかに値複写してください。つまり、コピーして右クリックなどで貼り付けるときに、「形式を選択して貼り付け」で「値」を指定して OK します。
No.1
- 回答日時:
K1:L18 のセル範囲に名簿がある場合。
C1 =rand()
G1 =vlookup(rank(c1,$C$1:$E$6),$K$1:$L$18,2,)
C1、G1 セルをコピーしそれぞれ C1:E6、G1:I6 に貼り付け、あるいはオートフィル。
![「エクセルで重ならないようランダムに並び替」の回答画像1](http://oshiete.xgoo.jp/_/bucket/oshietegoo/images/media/c/1037181_5497ea847d179/M.jpg)
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・ゆるやかでぃべーと タイムマシンを破壊すべきか。
- ・「I love you」 をかっこよく翻訳してみてください
- ・歩いた自慢大会
- ・許せない心理テスト
- ・字面がカッコいい英単語
- ・昔のあなたへのアドバイス
- ・かっこよく答えてください!!
- ・あなたが好きな本屋さんを教えてください
- ・スタッフと宿泊客が全員斜め上を行くホテルのレビュー
- ・【大喜利】【投稿~8/27】 こんなガソリンスタンド二度と来るか!なぜそう思った?
- ・これ何て呼びますか Part2
- ・人生で一番思い出に残ってる靴
- ・【お題】動物のキャッチフレーズ
- ・【お題】甲子園での思い出の残し方
- ・ゆるやかでぃべーと すべての高校生はアルバイトをするべきだ。
- ・「それ、メッセージ花火でわざわざ伝えること?」
- ・自分用のお土産
- ・人生で一番お金がなかったとき
- ・一番好きなみそ汁の具材は?
- ・泣きながら食べたご飯の思い出
- ・ちょっと先の未来クイズ第1問
- ・ゴリラ向け動画サイト「ウホウホ動画」にありがちなこと
- ・初めて自分の家と他人の家が違う、と意識した時
- ・単二電池
- ・チョコミントアイス
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excel SUMIF別ブックのシート名...
-
英数字のみ全角から半角に変換
-
【Excel VBA】PDFを作成して,...
-
マイクロソフト 一時使用コード...
-
会社PCのメールが更新されない
-
Microsoft Formsの「個人情報や...
-
エクセルでXLOOKUP関数...
-
大学のレポート A4で1枚レポー...
-
マクロ自動コピペ 貼り付ける場...
-
Officeを開くたびの「再起動メ...
-
office365って抵抗感ないですか?
-
teams設定教えて下さい。 ①ビデ...
-
マクロ1があります。 A1のセル...
-
Microsoft Officeを2台目のPCに...
-
web上にあるエクセルをショート...
-
あらかじめ用意したテンプレー...
-
Windows 11で、IME言語バー(IM...
-
【Excel】セル内の文字が正しい...
-
VBAファイルの保存先について
-
Microsoft familyに追加されま...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Officeを開くたびの「再起動メ...
-
英数字のみ全角から半角に変換
-
outlookのメールが固まってしま...
-
大学のレポート A4で1枚レポー...
-
マクロの書き方を教えて下さい
-
エクセルにおいて品名コードを...
-
マイクロソフト 一時使用コード...
-
マクロのコードを教えてください。
-
Microsoft Formsの「個人情報や...
-
一太郎でカーソルを次の行の先...
-
Microsoft365搭載Windows11PCへ...
-
エクセルでXLOOKUP関数...
-
エクセルやワードを無料で使え...
-
会社PCのメールが更新されない
-
teams設定教えて下さい。 ①ビデ...
-
現在、PC2台でMicrosoft 365 Pe...
-
Microsoft365で写真をアルバム...
-
office365って抵抗感ないですか?
-
Outlook で宛先が複数の場合の人数
-
Office2021を別のPCにインスト...
おすすめ情報