エクセルでのランダム抽出・並び替えについて
- エクセル初心者の方がオフィス2003を使用している場合に、Sheet1の任意の範囲からランダムに20〜21個のデータを抽出し、ランダムに並び替えたものをSheet2のB列に1000個作成する方法を教えてください。
- オフォス2003を使用しているエクセル初心者の方が、Sheet1のA1〜A55までの55行にバナナ、リンゴ、みかんなどの文字列が入力されている場合、Sheet1からランダムに20〜21個のデータを抽出し、ランダムに並び替えたものをSheet2のB列に1000個作成したいと思っています。質問した内容を改変して自分でマクロを作成しましたが、正しく動作しません。どのように修正すればよいでしょうか？
- エクセル初心者の方が、Sheet1の任意の範囲から20〜21個のデータをランダムに抽出し、ランダムに並び替えたものをSheet2のB列に1000個作成する方法を教えてください。質問した内容を改変して自分でマクロを作成しましたが、正しく動作しません。修正方法を教えてください。
- ベストアンサー
エクセルでのランダム抽出・並び替えについて
エクセル初心者です。オフィス2003を使用しています。 Sheet1のA1～A55まで５５行ある 各セルにバナナ、リンゴ、みかん・・・などの文字列があります。 これを Sheet2のB列に Sheet1からランダムに２０～２１個抽出し、 みかんリンゴバナナ・・・みたいに ランダムに並び替えたものを１０００個そろえたいと思っています。 http://oshiete1.goo.ne.jp/qa4993926.html で質問し、回答いただいたのですが、 実際の作業が、質問した内容から改変する必要があったため、 自分で改変してやってみると 「応答なし」の表示が出て、何度やってもうまくできません。 どうやら、上記ＵＲＬの質問では Ａ，Ｂ，Ｃといった各セル内の文字が１文字としていたために、 実際の作業のバナナ、リンゴなどといった文字数に対応できないようです。 自分で改変した以下のマクロの式を どのように改変したら、実際の作業に沿うようにできるのでしょうか？ ここから＊＊＊ Sub test02() Dim myRng As Range '変数宣言 Dim myDic As Object Dim x As Integer, myStr As String, v As String Randomize '乱数初期化 Set myRng = Sheets("マクロ用１").Range("A1:A55") 'データ範囲 Set myDic = CreateObject("Scripting.Dictionary") 'オブジェクト準備 Do Until myDic.Count = 1000 'ユニークで1000そろうまで x = Int(19 * Rnd) + 20 '乱数で桁数設定（20～21） myStr = "" Do Until Len(myStr) = x v = myRng(Int(55 * Rnd) + 1) '乱数で文字設定 If InStr(myStr, v) = 0 Then '文字列内で重複しなければ myStr = myStr & v '文字列につなげる End If Loop If Not myDic.exists(myStr) Then '単語が重複しなければ myDic.Add myStr, x '収録 End If Loop '繰り返し Sheets("マクロ用２").Range("B1").Resize(myDic.Count, 1).Value = Application.Transpose(myDic.Keys) '転記 End Sub ここまで＊＊＊ 先の質問を締め切ってしまったため、 もう一度質問させていただきました。 ご回答よろしくお願いします。
- nori213
- お礼率63% (7/11)
- オフィス系ソフト
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
nori213さん、またお会いしましたね。 セル内は一文字ではなく複数個の文字列だったということですね。 ではちょっと直しましょう。 Sub test03() Dim myRng As Range '変数宣言 Dim myDic As Object Dim x As Integer, i As Integer, myStr As String, v As String Randomize '乱数初期化 Set myRng = Sheets("マクロ用１").Range("A1:A55") 'データ範囲 Set myDic = CreateObject("Scripting.Dictionary") 'オブジェクト準備 Do Until myDic.Count = 1000 'ユニークで1000そろうまで x = Int(2 * Rnd) + 20 '乱数で個数設定（20～21） myStr = "" i = 0 Do Until i = x '指定個数になるまで v = myRng(Int(55 * Rnd) + 1) '乱数でセル選択 If InStr(myStr, v) = 0 Then '文字列内で重複がなければ myStr = myStr & v '文字列につなげる i = i + 1 'カウント End If Loop '繰り返し If Not myDic.exists(myStr) Then '重複しなければ myDic.Add myStr, x '収録 End If Loop '繰り返し Sheets("マクロ用２").Range("B1").Resize(myDic.Count, 1).Value = Application.Transpose(myDic.Keys) '転記 End Sub これでいかが？
関連するQ&A
- 短文をランダムに組み合わせ、長文を作りたい
エクセル初心者です。 オフィス2003を使用しています。 sheet1のＡ列の１行目～３３行目に Ａ１セル＝今日は天気が良い。朝から気温は２５度もある。 Ａ２セル＝体の調子は快調だ。気分もウキウキする。 Ａ３セル＝海水浴に出かけたいが、遠出は難しい。 ・・・・ といった短文があります。 これをランダムに４～５個抽出して、 すべて異なる長文を340通り作成したいと思います。 （文の順序はバラバラでかまいません。） マクロを使用し、 Sub test03() Dim myRng As Range '変数宣言 Dim myDic As Object Dim x As Integer, i As Integer, myStr As String, v As String Randomize '乱数初期化 Set myRng = Sheets("Sheet1").Range("A1:A33") 'データ範囲 Set myDic = CreateObject("Scripting.Dictionary") 'オブジェクト準備 Do Until myDic.Count = 340 'ユニークで340そろうまで x = Int(2 * Rnd) + 4 '乱数で個数設定（4～5） myStr = "" i = 0 Do Until i = x '指定個数になるまで v = myRng(Int(33 * Rnd) + 1) '乱数でセル選択 If InStr(myStr, v) = 0 Then '文字列内で重複がなければ myStr = myStr & v '文字列につなげる i = i + 1 'カウント End If Loop '繰り返し If Not myDic.exists(myStr) Then '重複しなければ myDic.Add myStr, x '収録 End If Loop '繰り返し Sheets("Sheet2").Range("B1").Resize(myDic.Count, 1).Value = Application.Transpose(myDic.Keys) '転記 End Sub 上記のように入力してみたのですが、 実行時エラー 型が一致しませんという表示が出て Sheets("Sheet2").Range("B1").Resize(myDic.Count, 1).Value = Application.Transpose(myDic.Keys) '転記 の部分が指定？されているのですが、 どこを直したらいいのかわかりません。 ２～３個抽出するだけだと上の式で できるのですが、 ４～５個の抽出にするとうまくできません。 訂正の仕方を教えてください。
- ベストアンサー
- オフィス系ソフト
- 【エクセルｖｂａ】(1)(2)(3)を区切りとして分けたい 配列
こんばんは。 もしエクセルで可能なら教えていただきたいです。（2003です） A1セルに (1)りんご(2)みかん(3)バナナ と入力されています。 これを A2にりんご、B2にみかん、C2にバナナ とSplitと使って区切りたいのですが不可能でしょうか？ 以下がここのサイトを参考にして作ったサンプルマクロです。 Sub サンプル() Dim myStr As String Dim ar As Variant myStr = Cells(1, 1) ar = Split(myStr, "") '←この部分をどうすればいいのかわからない Cells(2, 1).Resize(1, UBound(ar) + 1).Value = ar End Sub やはり、区切る文字が複数ある場合は不可能でしょうか？ ご教授よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- Excelで文字を置換したいのですが
A列の各セルに入っている文字列において、Bという文字があったらCに、無かったら文字を削除して空白にする、という作業を行いたいのです。 行数にして700行くらいありますので、マクロを考えました。 Replaceメソッドを使うのだと思い、ネットの記事を参考に、以下のマクロを書いてみましたが、「含まない」が機能しません。 「Bを含まない場合は削除する」というのはどのようにしたら良いでしょうか。 Sub macro9() 'Dictionaryオブジェクトの宣言 Dim myDic As Object Set myDic = CreateObject("Scripting.Dictionary") 'Dictionaryオブジェクトの初期化、要素の追加 myDic.Add "*B", "C" myDic.Add "<>B", "" 'Dictionaryオブジェクトを使った複数条件の置換 Dim bool As Boolean, myRange As Range Set myRange = Range("A3:A700") For Each Var In myDic bool = myRange.Replace(Var, myDic(Var)) Next Var End Sub
- ベストアンサー
- Excel（エクセル）
- エクセルでDictionaryオブジェクト
メリークリスマス！ とはいうものの仕事が終わりません。 これまでエクセルでDictionaryオブジェクトを利用し、AN列にある人名データをKeyにしてT列にある金額の集計を行っていました。 条件 AN列のデータには重複するものが多いが同姓同名は存在しない。 T列には必ず数値が入力されている。 AN列にある人名ごとにT列にある金額の集計を行う。 省略してますが以下のようなコードです。 Sub test01() Dim myDic As Object Dim x As Long Dim myC As Range Dim ws As Worksheet Set myDic = CreateObject("Scripting.Dictionary") x = Cells(Rows.Count, "AN").End(xlUp).Row For Each myC In Range("AN1:AN" & x) '受取人名列 If Not myDic.Exists(myC.Value) Then myDic.Add myC.Value, Cells(myC.Row, "T").Value 'T列の金額 Else myDic(myC.Value) = myDic(myC.Value) + Cells(myC.Row, "T").Value '金額を加算 End If Next Set ws = Worksheets.Add(After:=ActiveSheet) With ws '新規ワークシート .Range("A1").Resize(myDic.Count, 1).Value = Application.Transpose(myDic.keys) 'A列にデータ .Range("B1").Resize(myDic.Count, 1).Value = Application.Transpose(myDic.Items) 'B列に結びつけ金額データ End With Set myDic = Nothing End Sub これでうまくできていたのですが、今回新しい条件が加わり、頭を悩ませております。 新たな条件とは、同じ表のN列にあるコード（数字8桁）のうち、例えば77777777のものがあれば、追加したワークシートのC列にフラグをたてるというものです。 どのようにすればできるでしょうか？ よろしくお願いいたします。
- ベストアンサー
- Excel（エクセル）
- VBAでオートフィルを使って指定する文字列を含むものを表示させたい
VBAを使って、セルD1に入力した文字列を検索するマクロを作りたいと思っています。 私は初心者で前に似たようなものを作ってもらって それを加工しようとしたのですが、うまくいきませんでした。 以前は完全に一致するもので表示でしたが、 今回は含むものを表示させたいです。 ワイルドカードは＊をつけるのはわかるのですが、 いろいろやってみましたがダメでした。（単純なことかもしれないですけど） Private Sub Worksheet_Change(ByVal Target As Range) Dim myRng1 As Range Dim myRng2 As Range Set myRng1 = Target.Cells(1) If Application.Intersect(myRng1, Range("D1")) Is Nothing Then Exit Sub Set myRng2 = Range("D1").CurrentRegion With myRng2 If myRng1 = "" Then ActiveSheet.ShowAllData Else .AutoFilter Field:=4, Criteria1:=myRng1.Value End If End With End Sub
- 締切済み
- その他（プログラミング・開発）
- エクセルVBA
エクセル2003です 勉強中です 教えてください Sheet1 A B C D 1 日付 種類 数量1 数量2 2 2月3日 C 300 10 3 2月4日 B 200 5 4 2月5日 A 100 20 5 2月3日 A 100 10 6 2月4日 B 200 5 7 2月5日 C 300 20 8 2月3日 A 300 20 9 2月4日 C 200 5 10 2月5日 B 100 10 Sheet1 F G H I 1 日付 種類 数量1 数量2 2 2月3日 A 400 3 2月3日 C 300 4 2月4日 B 600 5 2月5日 A 100 6 2月5日 C 400 7 したい事 *A列～D列のデータをF列からI列へ複数条件の集計をしたいのですが *A列～D列の数値が変動すると勝手に自動で集計をして欲しい（シートがアクティブでなくても） *下記コードでC列までの集計ができますがD列の集計がわかりません （増やそうとすると頭の中がぐちゃぐちゃになって・・・） *前回の集計が残ってしまう Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim myDic As Object, myKey, myItem Dim myVal, myVal2, myVal3 Dim i As Long Range("F2", Range("I" & Rows.Count).End(xlUp)).ClearContents Range("F1:I1").Value = Range("A1:D1").Value Set myDic = CreateObject("Scripting.Dictionary") ' データを配列に格納 myVal = Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 4).Value ' myDicへデータを格納 For i = 1 To UBound(myVal, 1) myVal2 = myVal(i, 1) & "_" & myVal(i, 2) If Not myVal2 = "_" Then If Not myDic.exists(myVal2) Then myDic.Add myVal2, myVal(i, 3) Else myDic(myVal2) = myDic(myVal2) + myVal(i, 3) End If End If Next 'Key,Itemの書き出し myKey = myDic.keys myItem = myDic.items For i = 0 To UBound(myKey) myVal3 = Split(myKey(i), "_") Cells(i + 2, 6).Value = myVal3(0) Cells(i + 2, 7).Value = myVal3(1) Cells(i + 2, 8).Value = myItem(i) Next Set myDic = Nothing '並べ替え Range("F2", Range("H" & Rows.Count).End(xlUp)).Sort _ Key1:=Range("F2"), Order1:=xlAscending, _ Key2:=Range("G2"), Order2:=xlAscending, _ Header:=xlGuess End Sub 頭のなかがこんがらがってしまいます お願いです 出来れば説明付きで教えていただけませんか よろしくお願いします
- 締切済み
- オフィス系ソフト
- エクセルVBAで任意の文字列を抽出するには・・・
エクセル2003で作成した住所録があります。 県名（３文字）のみを抽出して、新たに設けたD列に表示させたいと考えています。 Sub 県名の列作成() Dim myStr As String myStr = ActiveCell.Value Range("D2").Value = Left(myStr,3) End Sub ここまで、できたのですが・・・・ B列の２行目から順に処理をして、一覧表の最後まで行って、 空白セルの行が見つかったら終了させる方法が分かりません。 どうかよろしくお願いします。
- ベストアンサー
- Visual Basic
- エクセルVBAで重複入力の排除
すでに入力規則はリストで使用しております。 そのためVBAで重複入力の排除を行おうと思います。 一応以下のコードでできたのですが、もっと良い方法があったら教えてください。 お願いいたします。 Private Sub Worksheet_Change(ByVal Target As Range) Dim myDic As Object Dim c As Variant, varData As Variant Dim i As Long If Application.Intersect(Target, Range("A1:A50")) Is Nothing Then Exit Sub Set myDic = CreateObject("Scripting.Dictionary") varData = Range("A1:A50").Value For Each c In varData If Not c = Empty Then i = i + 1 If Not myDic.Exists(c) Then myDic.Add c, Null End If End If Next If myDic.Count < i Then MsgBox Target & " は重複！" Application.EnableEvents = False Application.Undo Application.EnableEvents = True End If End Sub
- ベストアンサー
- Excel（エクセル）
- VBA エクセル 列の並び替え
左から右にA、B、Cと値が入っています。 ABC以外の文字が列に入っていたら、削除するというマクロを組みましたが、範囲を設定するところでエラーが出てしまいました。 なぜでしょうか？ 教えて下さい。 Sub arrange() Dim rg As Range Dim i As Long i = 1 Do rg = Cells(i, 1) If rg <> "A" And rg <> "B" And rg <> "C" Then Range(i & ":" & i).Delete End If i = i + 1 Loop Until (i & "1") = "" End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルVBAでDictionaryオブジェクトについて
エクセル2000です。 例えばA列に国名、B列に都市名、C列に団体名が切れ目なく並ぶリストがあります。 表はA列を基準にソートされています。 A列の同じ国名が終わる行のD列の1個のセルに、そこまでのC列で出てきた団体名を重複しないでカンマ区切りで表示しようと思います。 そのため、下記のようにDictionaryオブジェクトで団体名の重複を防いでいます。 Sub Test2() Dim i As Long Dim myStr As String Dim myDic Set myDic = CreateObject("Scripting.Dictionary") For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row If myDic.exists(Cells(i, "C").Value) = False Then myStr = myStr & Cells(i, "C").Value & "、" myDic.Add Cells(i, "C").Value, "" End If If Cells(i, "A") <> Cells(i + 1, "A") Then Cells(i, "D") = Left(myStr, Len(myStr) - 1) myStr = "" End If Next i End Sub 問題は、国をまたいで同じ団体名が出てきた場合、すでに上の方の国で変数myDicに登録されているため、登録されないということです。 上記コードでD列に変数myStを転記し、myStrを = ""にした時に、変数myDicの方もクリアしてしまえばいいとは思うのですが、どうやってクリアしたらよいのかわかりません。 ご教示くださいませ。 こんな感じにしたいのです。 日本 東京 abc 日本 横浜 bbc 日本 大阪 bbc 日本 名古屋 abc 日本 札幌 abc bbc、abc 韓国 ソウル kbc 韓国 プサン kkc 韓国 テグ kbc 韓国 テジョン abc 韓国 インチョン bbc kbc、kkc、bbc、abc 北朝鮮 ピョンヤン xxc 北朝鮮 テポドン xxc xxc 中国 北京 ccc 中国 南京 ccc 中国 上海 abc 中国 大連 kbc ccc、abc、kbc 表が上手く表示されませんが、各国名の最終行のB列都市名の右の1個はC列の団体名で、その右にくっついて見えるのがD列のカンマ区切りのデータです。
- ベストアンサー
- オフィス系ソフト
お礼
merlionXXさん、何度もありがとうございます。 おかげさまで 希望のものができました！ 残念ながら 私には式の意味が全くといっていいくらい理解できていないのですが、 これを機に、少しマクロも勉強してみようと思います。 ありがとうございました。