エクセル初心者です。
オフィス2003を使用しています。
sheet1のA列の1行目~33行目に
A1セル=今日は天気が良い。朝から気温は25度もある。
A2セル=体の調子は快調だ。気分もウキウキする。
A3セル=海水浴に出かけたいが、遠出は難しい。
・・・・
といった短文があります。
これをランダムに4~5個抽出して、
すべて異なる長文を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) '転記
の部分が指定?されているのですが、
どこを直したらいいのかわかりません。
2~3個抽出するだけだと上の式で
できるのですが、
4~5個の抽出にするとうまくできません。
訂正の仕方を教えてください。
No.3ベストアンサー
- 回答日時:
どうも配列に取り込みTransposeで変換する際に256文字以上の文字列がエラーに引っかかるようです。
それなら簡単な解決策を思いつきました。原始的ですが配列を用いず、直接セルに一個ずつ入力させれば大丈夫でした。(若干スピードが落ちますが)
Sub test05()
Dim myRng As Range '変数宣言
Dim myDic As Object
Dim x As Integer, i As Integer, myStr As String, v As String
Dim n As Long
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 '収録
n = n + 1
Sheets("Sheet2").Cells(n, "B").Value = myStr 'Sheet2に直接記入
End If
Loop '繰り返し
End Sub
何度もお手間おかけしました。
おかげさまで目的のものができました♪
スピードも全然問題ありませんでした。
またの機会がありましたら、ぜひご教授いただければと思います。
本当にありがとうございました。
No.2
- 回答日時:
> 想定される文字数も200~400文字くらいなので
原因はこれのようです。
ためしに255文字で切って見るとエラーにはならないと思います。
Sub test04()
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 '文字列につなげる
myStr = Left(myStr, 255) '256文字以上はエラー
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
役にはたちませんが・・・・。
また別の方法を考えます。少し時間をください。
No.1
- 回答日時:
nori213さんこんいちは。
またお会いしましたね。
ご提示のコードをそのままコピペしてやってみましたが正常に作動しましたよ。
エラーがでるとしたらSheet1のデータの中にエラー値が混じってないですか?
この回答への補足
merlionXXさん、いつもありがとうございます。
前回教えていただいたマクロは
非常に使えて重宝してます(*^ ^*)
念のため、
マクロで使う部分だけを新規にエクセルで作成して
何度かやってみたのですが、
同じ結果でした。
1つのセルに入る文字数を少なくしてみると
上の式で問題なく動作するのですが、
長文になると
なぜか上記のエラーが出てしまいます。
実際に使う短文が
ホームページ用のタグ
例えば<br>,<font>などを含んでいることが原因なのでしょうか?
ただ、この場合でも
抽出数を2~3個にすると問題なく動作しますし、
4~5個抽出した場合に想定される文字数も200~400文字くらいなので、特に問題はないと思われます。
ちなみに「Sheet1のデータの中にエラー値」というのは
どういったものがエラー値になるのでしょうか?
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) vba 重複データ合算 5 2023/07/05 18:55
- Visual Basic(VBA) Sheet2からオートフィルターで売上日を抽出した件数をカウントし、その件数をSheet1のセルB1 2 2023/01/12 12:24
- Visual Basic(VBA) Sheet「状況」から、分類の年齢別カウント数をSheet「D表」へ転記する下記マクロを作っています 7 2022/12/14 17:57
- Visual Basic(VBA) 前回ご教授いただいたコードに覚えたてのループ処理で品名りんごAから順に20回for nextでループ 7 2023/01/13 22:01
- Visual Basic(VBA) VBAが止まります。 3 2022/08/31 14:09
- Visual Basic(VBA) まとめシートから集計シートへA列のコードが一致したら1行コピーするマクロをネット上で見つけました。こ 1 2022/08/30 14:11
- Visual Basic(VBA) オブジェクトが見つかりません 1 2023/06/24 19:43
- Visual Basic(VBA) このVBAでExcelアプリケーションを作成は必要ですか? 3 2023/07/19 21:13
- Visual Basic(VBA) 3つのプロシージャをまとめたら実行時エラー発生で対応不能 6 2022/05/17 01:47
- Visual Basic(VBA) VBAでoutlook365が起動しません。 4 2022/08/25 13:31
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルVBA、別ブックへ転記す...
-
エクセルのデーターが2か月前の...
-
エクセル共有したが、アクセス...
-
エクセル②
-
エクセルの計算
-
【マクロ】顧客番号にて一致さ...
-
エクセルを使っていて2024/5/15...
-
(マクロ)データをAブックからB...
-
Microsoft 365の Excel を使用...
-
エクセルで日付を数字+アルフ...
-
Excel
-
Excelでセルの値が同じか...
-
エクセル 文字を増やしたい。
-
UNIQUE関数が使えないバージョ...
-
指定文字の間に
-
Googleスプレッドシートでファ...
-
エクセルで年休を管理する方法...
-
Microsoft365に変えたのですが...
-
エクセルの暗号化なしのバーの...
-
Excelで縦軸の書式を0:00形式の...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excel2010でふりがなが漢字にな...
-
エクセルの文字間スペースを入...
-
VBAで横データを縦データに変換...
-
【マクロ】セルの塗りつぶし色...
-
短文をランダムに組み合わせ、...
-
不明なコマンドです("FROM")。...
-
Access2010 「演算子がありませ...
-
【ExcelVBA】sheet作成時にマク...
-
オペランドが足りませんとコメ...
-
エクセル/マクロ Exit Subが実...
-
VBA シートの切り替えができな...
-
pythonでrequestsが使えない
-
mfc42.dllファイルってなんです...
-
マクロ実行ボタンがコピー出来ない
-
VBAでシートコピー後、シート名...
-
貼り付けをマクロで禁止させたい。
-
WordPressをインストールしてい...
-
(int)キャストとintvalの違い
-
AUTOCAD 2010でdwlファイルの場...
-
OBSが起動できません
おすすめ情報