エクセルＶＢＡについて質問です。

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

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