エクセルVBAについて質問です。


現在、指定した数分の文字をランダムに置換するプログラムを作成したいと考えています。

プログラムを実行したいエクセルの状況ですが以下になります。

http://oskuni7.sakura.ne.jp/hatena/question8/question.htm

★行いたい処理の流れは以下になります。

プログラムを実行するとダイアログボックスが出てきて、変更したい文字数を入力してくださいの画面が出てきます。

その後、置換したい文字数を入力し、OKボタンを押すと指定した数字分の文字をランダムに変更してくれます。

エクセルのURLでは ああ と書かれてある文字を えええ に指定した分だけ変更するようになっています。

上記の流れの処理のプログラムを組める方おりましたら、お手数をおかけしますがよろしくお願いいたします。

回答の条件
  • 1人2回まで
  • 登録:2009/01/13 02:46:53
  • 終了:2009/01/18 15:55:46

ベストアンサー

id:s-n-k No.1

s-n-k回答回数27ベストアンサー獲得回数22009/01/13 03:54:27

ポイント100pt

http://oskuni7.sakura.ne.jp/hatena/question8/question.htm ダミーです。

Sub test()

    Randomize

    Const SrcWord As String = "ああ"
    Const DstWord As String = "えええ"

    Dim MyBook As Workbook
    Dim TargetSheet As Worksheet
    Dim TargetRange As Range
    Dim FindCell As Range
    Dim FindCells As New Collection
    Dim RepCount As Long
    Dim RndNums() As Long
    Dim RndNum As Long
    Dim i As Long
    
    Set MyBook = ThisWorkbook
    Set TargetSheet = Sheets("Sheet1")
    Set TargetRange = TargetSheet.Range(Range("AH1"), Range("AH65536").End(xlUp))
    
    RepCount = InputBox("何個のデータを変更しますか?")
    
    ' 置換する対象の文字列を取得
    Set FindCell = TargetRange.Find(SrcWord, , xlValue, xlWhole, xlByRows, xlNext, True)
    If Not FindCell Is Nothing Then
        FindCells.Add Item:=FindCell, key:=FindCell.Address
    End If

    Do While True
        Set FindCell = TargetRange.FindNext(FindCell)
        If FindCell Is Nothing Then
            Exit Do
        End If
        If FindCells(1).Address = FindCell.Address Then
            Exit Do
        End If
        FindCells.Add Item:=FindCell, key:=FindCell.Address
    Loop
    
    If FindCells.Count < RepCount Then
        MsgBox "データ数が少ない"
    End If

    ' 乱数のテーブルを作る
    ReDim RndNums(FindCells.Count)
    For i = 0 To FindCells.Count
        RndNum = Int((FindCells.Count + 1) * Rnd)
        RndNums(i) = RndNum
        RndNums(RndNum) = i
    Next i

    ' 指定された分だけ値を書き換える
    For i = 0 To RepCount - 1
        FindCells(RndNums(i)).Value = DstWord
    Next i

End Sub

このような処理でいかがでしょうか。

id:aiomock

ご回答ありがとうございます。

プログラム実行させていただきました。

実行してみたところ

エラー9

インデックスが有効範囲にありません

というエラーが発生しております。

選択範囲として H4~H65536まで設定をしたりもしたのですが、こういったことでもないのでしょうか。

プログラムですが、””文字列の中だけ変更しました。

対処方法としてはどのような対処方法があるのでしょうか?

お手数をおかけしますがよろしくお願いいたします。

2009/01/13 11:14:30

その他の回答(1件)

id:s-n-k No.1

s-n-k回答回数27ベストアンサー獲得回数22009/01/13 03:54:27ここでベストアンサー

ポイント100pt

http://oskuni7.sakura.ne.jp/hatena/question8/question.htm ダミーです。

Sub test()

    Randomize

    Const SrcWord As String = "ああ"
    Const DstWord As String = "えええ"

    Dim MyBook As Workbook
    Dim TargetSheet As Worksheet
    Dim TargetRange As Range
    Dim FindCell As Range
    Dim FindCells As New Collection
    Dim RepCount As Long
    Dim RndNums() As Long
    Dim RndNum As Long
    Dim i As Long
    
    Set MyBook = ThisWorkbook
    Set TargetSheet = Sheets("Sheet1")
    Set TargetRange = TargetSheet.Range(Range("AH1"), Range("AH65536").End(xlUp))
    
    RepCount = InputBox("何個のデータを変更しますか?")
    
    ' 置換する対象の文字列を取得
    Set FindCell = TargetRange.Find(SrcWord, , xlValue, xlWhole, xlByRows, xlNext, True)
    If Not FindCell Is Nothing Then
        FindCells.Add Item:=FindCell, key:=FindCell.Address
    End If

    Do While True
        Set FindCell = TargetRange.FindNext(FindCell)
        If FindCell Is Nothing Then
            Exit Do
        End If
        If FindCells(1).Address = FindCell.Address Then
            Exit Do
        End If
        FindCells.Add Item:=FindCell, key:=FindCell.Address
    Loop
    
    If FindCells.Count < RepCount Then
        MsgBox "データ数が少ない"
    End If

    ' 乱数のテーブルを作る
    ReDim RndNums(FindCells.Count)
    For i = 0 To FindCells.Count
        RndNum = Int((FindCells.Count + 1) * Rnd)
        RndNums(i) = RndNum
        RndNums(RndNum) = i
    Next i

    ' 指定された分だけ値を書き換える
    For i = 0 To RepCount - 1
        FindCells(RndNums(i)).Value = DstWord
    Next i

End Sub

このような処理でいかがでしょうか。

id:aiomock

ご回答ありがとうございます。

プログラム実行させていただきました。

実行してみたところ

エラー9

インデックスが有効範囲にありません

というエラーが発生しております。

選択範囲として H4~H65536まで設定をしたりもしたのですが、こういったことでもないのでしょうか。

プログラムですが、””文字列の中だけ変更しました。

対処方法としてはどのような対処方法があるのでしょうか?

お手数をおかけしますがよろしくお願いいたします。

2009/01/13 11:14:30
id:abhrsh No.2

abhrsh回答回数4ベストアンサー獲得回数02009/01/13 15:00:44

ポイント100pt

http://www.yahoo.co.jp/

URLはダミーです。


横から失礼します。

s-n-kさんの回答にあるスクリプトで、

「インデックスが有効範囲にありません」

というエラーが出るということは、

Excelのバージョンの違いが原因かもしれません。


下記の部分を修正されれば解消するのではないでしょうか。

Set FindCell = TargetRange.Find(SrcWord, , xlValue, xlWhole, xlByRows, xlNext, True)

                ↓

Set FindCell = TargetRange.Find(SrcWord, , xlValues, xlWhole, xlByRows, xlNext, True)
id:aiomock

ご回答ありがとうございます。

プログラムですが通常に起動いたしました。

ありがとうございます。

2009/01/13 15:15:27
  • id:s-n-k
    abhrsh さん、ご指摘ありがとうございます。我が家の Excel が古かったようです。

    aiomock さん、無事動いたようでよかったです。中途半端なサンプルを提供してしまい申し訳ございません。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません