Excel(エクセル)2007のVBAで、

「極力重複しないランダム置換プログラム」になるように作成途中のソースを修正してほしいです。
文字数制限の関係で、ここに書ききれない部分を、最後に「補足」としてリンク先に書きましたのでどうか読んでください。



手順

①A列に「置換前のデータ」を含んだ文章入力。
A1:(動物)と(動物)が好き
A2:(動物)と(動物)と(動物)は可愛い。だから(動物)と(動物)と(動物)が好き


②B列に"(動物)"の「置換後のデータ」入力。
B1:犬
B2:猫
B3:鳥


③コマンドボタンで
A列の"(動物)"を、B列の"犬"と"猫"と"鳥"のどれか1つで必ず置換して
その結果を「C列」に表示。
それも、重複しないランダム置換です。



※作成途中のソース※(修正してほしいソースです。)

http://kanzentaini4.com/test1.html



※※補足※※(必ず読んでいただきたいです。)
  ↓
http://kanzentaini4.com/hosoku.html



分かる方、できる方いましたら修正したソースを教えてください。
どうかよろしくお願いします。

回答の条件
  • 1人50回まで
  • 13歳以上
  • 登録:2011/04/12 22:33:39
  • 終了:2011/04/13 11:50:30

ベストアンサー

id:Mook No.2

Mook回答回数1312ベストアンサー獲得回数3912011/04/13 08:12:04

ポイント100pt

ポイントは自由に変更できるので、コメント文での追加回答を最初の回答に上乗せしていただくこともできます。

私としては一回当たりのポイントが気になっているので、2回で70ptより1回で60ptの方が嬉しいです。

仕様の確認をしたいこともありますので、いずれにせよコメント欄は有効にお願いします。


さて、同じような処理を繰り返したい場合は、パターン化すると処理がシンプルになります。

関数が増えるのは面倒そうですが、同じことを繰り返し書かなくてよいので、全体の

管理が楽になりますし、今回の変更でかえってコードが見やすくなったのではないかと思います。


Option Explicit

'// コマンドボタン処理
'//-----------------------------------
Private Sub CommandButton1_Click()
    Dim replaceArrayB As Variant
    Dim replaceArrayC As Variant
    Dim replaceArrayD As Variant
    
    With ThisWorkbook.Sheets("Sheet1")
        replaceArrayB = makeArray(.Range("B1").Resize(.Range("B" & .Rows.Count).End(xlUp).Row, 1))
        replaceArrayC = makeArray(.Range("C1").Resize(.Range("C" & .Rows.Count).End(xlUp).Row, 1))
        replaceArrayD = makeArray(.Range("D1").Resize(.Range("D" & .Rows.Count).End(xlUp).Row, 1))
    
        Dim CellA As Range
        Dim res As String
        For Each CellA In .Range("A1").Resize(.Range("A" & .Rows.Count).End(xlUp).Row, 1)
            res = replacePhrase(CellA.Value, "(動物)", replaceArrayB)
            res = replacePhrase(res, "(好き)", replaceArrayC)
            CellA.Offset(0, 4).Value = replacePhrase(res, "(可愛い)", replaceArrayD)
        Next
    End With
End Sub

'// 配列を使用してランダムに置き換え
'//-----------------------------------
Function replacePhrase(phrase, searchWord, replaceArray)
    Dim pArray As Variant
    Dim arrayIndex As Long
    Dim i As Long
        
    '// 配列のシャッフル
    arrayIndex = 0
    shuffleArray replaceArray
    pArray = Split(phrase, searchWord)
    replacePhrase = pArray(0)
    For i = 1 To UBound(pArray)
        replacePhrase = replacePhrase & replaceArray(arrayIndex) & pArray(i)
        arrayIndex = arrayIndex + 1
        If arrayIndex > UBound(replaceArray) Then
    '// 一巡したら配列を再シャッフル
            arrayIndex = 0
            shuffleArray replaceArray
        End If
    Next
End Function

'// 指定したレンジから配列に作成
'//-----------------------------------
Function makeArray(wordRange)
        Dim r As Range
        Dim res As String
        
        For Each r In wordRange
            If res = "" Then
                res = r.Value
            Else
                res = res & "/" & r.Value
            End If
        Next
        makeArray = Split(res, "/")
End Function

'// 配列の単語を並べ替える
'//-----------------------------------
Sub shuffleArray(wordArray)
    Dim r As Long
    r = UBound(wordArray)

    Dim i As Long, j As Long, s As Long, t As String
    For i = 1 To 3 '// 気持ちだけ多めにシャッフル:省略も可。
        For j = 0 To r
            s = Int(Rnd() * (r + 1))
            t = wordArray(s)
            wordArray(s) = wordArray(j)
            wordArray(j) = t
        Next
    Next
End Sub
id:egaosaiko

Mookさんへ

こんなに早く的確なコードを考えていただき、大変ありがたいです。

今回もまた、何度試してもエラーもなく希望通りの処理結果になるのですごく嬉しいかぎりです。

感動しています!

それからポイントシステムの特性について、わかりやすく色々教えていただきありがとうございます。

とりあえずコメント欄の有効を優先させていただきますので、どうぞよろしくおねがいいたします。

2011/04/13 11:47:05

その他の回答(1件)

id:Mook No.1

Mook回答回数1312ベストアンサー獲得回数3912011/04/13 00:46:54

ポイント100pt

ほとんど原形をとどめていませんが、面白そうなので作成してみました。

一応動作確認してありますが、問題がありましたらコメント対応しますので、

下記の「この質問・回答へのコメント」を有効にお願いします。

Option Explicit

Private Sub CommandButton1_Click()
    Const searchWord = "(動物)"  '// 置換する検索語

    With ThisWorkbook.Sheets("Sheet1")
    '// 置換対象の配列の作成
        Dim CellA As Range
        Dim res As String
        Dim replaceArray As Variant
        For Each CellA In .Range("B1").Resize(.Range("B" & .Rows.Count).End(xlUp).Row, 1)
            If res = "" Then
                res = CellA.Value
            Else
                res = res & "/" & CellA.Value
            End If
        Next
        replaceArray = Split(res, "/")
        
    '// 置換処理
        Dim pArray As Variant
        Dim arrayIndex As Long
        Dim i As Long
        For Each CellA In .Range("A1").Resize(.Range("A" & .Rows.Count).End(xlUp).Row, 1)
            '// 配列のシャッフル
            arrayIndex = 0
            shuffleArray replaceArray
            pArray = Split(CellA, searchWord)
            res = pArray(0)
            For i = 1 To UBound(pArray)
                res = res & replaceArray(arrayIndex) & pArray(i)
                arrayIndex = arrayIndex + 1
                If arrayIndex > UBound(replaceArray) Then
            '// 一巡したら配列を再シャッフル
                    arrayIndex = 0
                    shuffleArray replaceArray
                End If
            Next
            CellA.Offset(0, 2).Value = res
        Next
    End With
End Sub

'// 検索語を並べ替える
Sub shuffleArray(wordArray)
    Dim r As Long
    r = UBound(wordArray)

    Dim i As Long, j As Long, s As Long, t As String
    For i = 1 To 3
        For j = 0 To r
            s = Int(Rnd() * (r + 1))
            t = wordArray(s)
            wordArray(s) = wordArray(j)
            wordArray(j) = t
        Next
    Next
End Sub
id:egaosaiko

Mook さん

私のやりたいことが完璧にできていました。

エラーもありません。

本当にありがとうございます。

ずっと悩んでいたので、嬉しいです。


実はここからもう1つやりたいことがありまして、

Mookさんのソースをかなりいじってたのですが、

どうしても置換してくれるところと置換してくれないところがまざってしまったりエラーになるので、どうにか次のようなソースも教えていただけないでしょうか。

一言でいいますと、重複しないランダム置換機能はそのままに、

「置換前のデータ」を増やしていきたいのです。

具体的には



「A列」

A1:(動物)と(動物)が(好き)

A2:(動物)と(動物)と(動物)は(可愛い)。だから(動物)と(動物)と(動物)が(好き)


「B列」:"(動物)"の「置換後のデータ」

B1:犬

B2:猫

B3:鳥


「C列」:"(好き)"の「置換後のデータ」

C1:好き

C2:大好き

C3:気に入っている


「D列」:"(可愛い)"の「置換後のデータ」

D1:可愛い

D2:かわいい

D3:カワイイ


※「E列」にランダム置換結果を表示。


↑のような感じで、A列の文章の「ランダム置換できる箇所」を増やしていきたいのです。

上記の、

>「A列」

>A1:(動物)と(動物)が(好き)

>A2:(動物)と(動物)と(動物)は(可愛い)。だから(動物)と(動物)と(動物)が(好き)

もあくまで例文なのですが

この例文の場合

新たに追加する2つの

●「C列」:"(好き)"の「置換後のデータ」

C1:好き

C2:大好き

C3:気に入っている


●「D列」:"(可愛い)"の「置換後のデータ」

D1:可愛い

D2:かわいい

D3:カワイイ

↑これらもランダム置換するためには、上記で教えていただいたソースにどのように組み込めばいいのでしょうか。

組み込んだソースで教えていただきたいのです。

(この先もどうか読んで欲しいです。)

 ↓↓↓


※このプログラムでどうしても守りたいのが

ランダム置換処理する順番なんですが、

エクセルの列の並び順(ABCDE・・・という左から右への順番)通りに処理するようにしたいです。


具体的には

「置換後のデータ」にランダム置換する順番が、

●「B列:(動物)」のランダム置換→「C列:(好き)」のランダム置換→「D列:(可愛い)」のランダム置換→・・・

のようになればいいなと思っています。

なので、同時に

●「A列の"(動物)"がランダム置換された文章」をE列に表示

  ↓

 「E列の"(好き)"もランダム置換された文章」をE列に表示

  ↓

 「E列の"(可愛い)"もランダム置換された文章」をE列に表示

  ↓

  ・

  ・

  ・

という処理の順番になると思います。



Mook さん

もし時間ができましたら、

どうかこれらの条件を満たすVBAソースをよろしくおねがいいたします。

「この質問・回答へのコメント」欄にここまでを書いてしまうと、

回答ポイントもあげないで教えていただくことになるので、

「この回答に返信する」欄に書かせていただきました。

2011/04/13 03:53:42
id:Mook No.2

Mook回答回数1312ベストアンサー獲得回数3912011/04/13 08:12:04ここでベストアンサー

ポイント100pt

ポイントは自由に変更できるので、コメント文での追加回答を最初の回答に上乗せしていただくこともできます。

私としては一回当たりのポイントが気になっているので、2回で70ptより1回で60ptの方が嬉しいです。

仕様の確認をしたいこともありますので、いずれにせよコメント欄は有効にお願いします。


さて、同じような処理を繰り返したい場合は、パターン化すると処理がシンプルになります。

関数が増えるのは面倒そうですが、同じことを繰り返し書かなくてよいので、全体の

管理が楽になりますし、今回の変更でかえってコードが見やすくなったのではないかと思います。


Option Explicit

'// コマンドボタン処理
'//-----------------------------------
Private Sub CommandButton1_Click()
    Dim replaceArrayB As Variant
    Dim replaceArrayC As Variant
    Dim replaceArrayD As Variant
    
    With ThisWorkbook.Sheets("Sheet1")
        replaceArrayB = makeArray(.Range("B1").Resize(.Range("B" & .Rows.Count).End(xlUp).Row, 1))
        replaceArrayC = makeArray(.Range("C1").Resize(.Range("C" & .Rows.Count).End(xlUp).Row, 1))
        replaceArrayD = makeArray(.Range("D1").Resize(.Range("D" & .Rows.Count).End(xlUp).Row, 1))
    
        Dim CellA As Range
        Dim res As String
        For Each CellA In .Range("A1").Resize(.Range("A" & .Rows.Count).End(xlUp).Row, 1)
            res = replacePhrase(CellA.Value, "(動物)", replaceArrayB)
            res = replacePhrase(res, "(好き)", replaceArrayC)
            CellA.Offset(0, 4).Value = replacePhrase(res, "(可愛い)", replaceArrayD)
        Next
    End With
End Sub

'// 配列を使用してランダムに置き換え
'//-----------------------------------
Function replacePhrase(phrase, searchWord, replaceArray)
    Dim pArray As Variant
    Dim arrayIndex As Long
    Dim i As Long
        
    '// 配列のシャッフル
    arrayIndex = 0
    shuffleArray replaceArray
    pArray = Split(phrase, searchWord)
    replacePhrase = pArray(0)
    For i = 1 To UBound(pArray)
        replacePhrase = replacePhrase & replaceArray(arrayIndex) & pArray(i)
        arrayIndex = arrayIndex + 1
        If arrayIndex > UBound(replaceArray) Then
    '// 一巡したら配列を再シャッフル
            arrayIndex = 0
            shuffleArray replaceArray
        End If
    Next
End Function

'// 指定したレンジから配列に作成
'//-----------------------------------
Function makeArray(wordRange)
        Dim r As Range
        Dim res As String
        
        For Each r In wordRange
            If res = "" Then
                res = r.Value
            Else
                res = res & "/" & r.Value
            End If
        Next
        makeArray = Split(res, "/")
End Function

'// 配列の単語を並べ替える
'//-----------------------------------
Sub shuffleArray(wordArray)
    Dim r As Long
    r = UBound(wordArray)

    Dim i As Long, j As Long, s As Long, t As String
    For i = 1 To 3 '// 気持ちだけ多めにシャッフル:省略も可。
        For j = 0 To r
            s = Int(Rnd() * (r + 1))
            t = wordArray(s)
            wordArray(s) = wordArray(j)
            wordArray(j) = t
        Next
    Next
End Sub
id:egaosaiko

Mookさんへ

こんなに早く的確なコードを考えていただき、大変ありがたいです。

今回もまた、何度試してもエラーもなく希望通りの処理結果になるのですごく嬉しいかぎりです。

感動しています!

それからポイントシステムの特性について、わかりやすく色々教えていただきありがとうございます。

とりあえずコメント欄の有効を優先させていただきますので、どうぞよろしくおねがいいたします。

2011/04/13 11:47:05
  • id:Mook
    無事動いたようで何よりです。
    たくさんのポイントもありがとうございました。

    今回は説明がしっかりしていたので、迷うことはありませんでしたが、
    不明な部分があれば回答前に確認したいことは多いですので、このコメント欄は
    質問時に有効にしておいていただけると嬉しいです。
  • id:egaosaiko
    Mookさんへ

    >このコメント欄は
    >質問時に有効にしておいていただけると嬉しいです。
    有用なご意見、とてもありがたいです。
    すぐに反映いたします。


    さっそくなんですが、

    プラグラムの仕様ではなく「エクセルのデザイン」を少しだけ変更したので、
    それに伴いコードをいじっているのですが、行き詰ってしまったので「コードの変更箇所」とそのコードを教えていただきたいです。

    具体的には

    エクセルの「すべての列の1行目」を、(分かりやすいように)見出しのように使うことにしました。
    ↓↓↓
    A1:置換前の文章

    B1:(動物)の置換語

    C1:(好き)の置換語

    D1:(可愛い)の置換語

    E1:置換後の文章

    上記のように、「すべての列の1行目」には常にデータが入っている状態になったので、
    これからは「すべての列の2行目」からのデータが、ランダム置換に使うデータとなります。

    1行分下げても、今まで通りの(ランダム)機能を維持したいのです。


    なので、

    「すべての列の1行目」から処理するように書かれたコード(今までのコード)
       ↓↓↓
    「すべての列の2行目」から処理するように書かれたコード

    へと修正していただきたいのです。
    もちろん、この質問ページの「ベストアンサー」に選ばれたコードを修正してくれると嬉しいです。


    Mookさん
    どうかよろしくおねがいします。
    毎回ありがとうございます。
  • id:Mook
    基本的にはセル範囲の修正なので
      replaceArrayB = makeArray(.Range("B1").Resize(.Range("B" & .Rows.Count).End(xlUp).Row, 1))
      replaceArrayC = makeArray(.Range("C1").Resize(.Range("C" & .Rows.Count).End(xlUp).Row, 1))
      replaceArrayD = makeArray(.Range("D1").Resize(.Range("D" & .Rows.Count).End(xlUp).Row, 1))

      replaceArrayB = makeArray(.Range("B2").Resize(.Range("B" & .Rows.Count).End(xlUp).Row-1, 1))
      replaceArrayC = makeArray(.Range("C2").Resize(.Range("C" & .Rows.Count).End(xlUp).Row-1, 1))
      replaceArrayD = makeArray(.Range("D2").Resize(.Range("D" & .Rows.Count).End(xlUp).Row-1, 1))


      For Each CellA In .Range("A1").Resize(.Range("A" & .Rows.Count).End(xlUp).Row, 1)

      For Each CellA In .Range("A2").Resize(.Range("A" & .Rows.Count).End(xlUp).Row-1, 1)
    でできないでしょうか。
  • id:egaosaiko
    Mookさんへ

    返信ありがとうございます。

    書かれている通り修正したら、
    エラーなく完璧な形で動きました。

    本当にありがとうございます。

    もう細かいところも含めて、このVBAツールは完成間近だと思います。
    これもMookさんのおかげです。
  • id:egaosaiko
    Mookさんへ

    質問というより確認になるのですが、

    たとえば


    A列(A2~):置換前の文章

    B列(B2~):(置換したい箇所1)のデータ
    C列(C2~):(置換したい箇所2)のデータ
    D列(D2~):(置換したい箇所3)のデータ
    E列(E2~):(置換したい箇所4)のデータ
    F列(F2~):(置換したい箇所5)のデータ
    G列(G2~):(置換したい箇所6)のデータ
    H列(H2~):(置換したい箇所7)のデータ
    I列(I2~):(置換したい箇所8)のデータ
    J列(J2~):(置換したい箇所9)のデータ
    K列(K2~):(置換したい箇所10)のデータ

    L列(L2~):置換後の文章(A列の文章を置換したもの)


    上記の条件でランダム置換したい場合、
    次のようなコードで間違いないのでしょうか。変更が必要な部分(コマンドボタン処理)のコードだけ載せておきます。
    (動作確認はできているのですが、一応再確認しておきたいのです。)
    ↓↓↓



    Option Explicit

    '// コマンドボタン処理
    '//-----------------------------------
    Private Sub CommandButton1_Click()
    Dim replaceArrayB As Variant
    Dim replaceArrayC As Variant
    Dim replaceArrayD As Variant
      Dim replaceArrayE As Variant
      Dim replaceArrayF As Variant
      Dim replaceArrayG As Variant
    Dim replaceArrayH As Variant
    Dim replaceArrayI As Variant
      Dim replaceArrayJ As Variant
      Dim replaceArrayK As Variant

    With ThisWorkbook.Sheets("Sheet1")
    replaceArrayB = makeArray(.Range("B2").Resize(.Range("B" & .Rows.Count).End(xlUp).Row-1, 1))
        replaceArrayC = makeArray(.Range("C2").Resize(.Range("C" & .Rows.Count).End(xlUp).Row-1, 1))
        replaceArrayD = makeArray(.Range("D2").Resize(.Range("D" & .Rows.Count).End(xlUp).Row-1, 1))
    replaceArrayE = makeArray(.Range("E2").Resize(.Range("E" & .Rows.Count).End(xlUp).Row-1, 1))
        replaceArrayF = makeArray(.Range("F2").Resize(.Range("F" & .Rows.Count).End(xlUp).Row-1, 1))
        replaceArrayG = makeArray(.Range("G2").Resize(.Range("G" & .Rows.Count).End(xlUp).Row-1, 1))
    replaceArrayH = makeArray(.Range("H2").Resize(.Range("H" & .Rows.Count).End(xlUp).Row-1, 1))
        replaceArrayI = makeArray(.Range("I2").Resize(.Range("I" & .Rows.Count).End(xlUp).Row-1, 1))
        replaceArrayJ = makeArray(.Range("J2").Resize(.Range("J" & .Rows.Count).End(xlUp).Row-1, 1))
    replaceArrayK = makeArray(.Range("K2").Resize(.Range("K" & .Rows.Count).End(xlUp).Row-1, 1))
        
        Dim CellA As Range
    Dim res As String
    For Each CellA In .Range("A2").Resize(.Range("A" & .Rows.Count).End(xlUp).Row-1, 1)
    res = replacePhrase(CellA.Value, "(置換したい箇所1)", replaceArrayB)
    res = replacePhrase(res, "(置換したい箇所2)", replaceArrayC)
          res = replacePhrase(res, "(置換したい箇所3)", replaceArrayD)
          res = replacePhrase(res, "(置換したい箇所4)", replaceArrayE)
          res = replacePhrase(res, "(置換したい箇所5)", replaceArrayF)
          res = replacePhrase(res, "(置換したい箇所6)", replaceArrayG)
          res = replacePhrase(res, "(置換したい箇所7)", replaceArrayH)
          res = replacePhrase(res, "(置換したい箇所8)", replaceArrayI)
          res = replacePhrase(res, "(置換したい箇所9)", replaceArrayJ)
    CellA.Offset(0, 11).Value = replacePhrase(res, "(置換したい箇所10)", replaceArrayK)
    Next
    End With
    End Sub




    おそらく異常はないと思うのですが、私だけでは判断できないので

    Mookさん
    これで間違いないかどうか、確認のほう、どうかよろしくおねがいします。
    何度もありがとうございます。
  • id:Mook
    これだけ多いと配列を利用したい気もしますが、問題ないともいます。

    配列を利用して、変換したい文字列(置換したい箇所*)を2行目に書いておき、
    その下に選択肢を書くようにすると、コードの修正無く対象を変更することも可能です。
    また、列そのものに変換をすると判別できる工夫をしておけば、変更数を動的に変更
    しながら運用も可能ですね。
    このあたりは、プログラミングの拡張性・保守性と呼ばれる範疇です。

    まぁ御託を並べましたが、今回の変更のためには上記で十分でしょう。
  • id:egaosaiko
    Mookさん

    ご返答ありとうございます。

    とりあえず問題ないということで安心しました。


    (置換したい箇所*)の数は、実際は50~100、いやそれ以上になるとは思います。

    本当は
    >配列を利用して、変換したい文字列(置換したい箇所*)を2行目に書いておき、
    >その下に選択肢を書くようにすると、コードの修正無く対象を変更することも可能です。
    >また、列そのものに変換をすると判別できる工夫をしておけば、変更数を動的に変更
    >しながら運用も可能ですね。
    こんなこともしてみたいのですが(書いてあること自体ほぼ理解できていないですが)、
    つい先日まで

    (置換したい箇所*)の数=コマンドボタンの数
    でランダム置換処理していたくらいなので(しかも一回一回の処理も遅いです)、ご想像の通り、いまのところ夢物語です・・・

    Mookさんには頭が下がる一方です。
  • id:egaosaiko
    Mookさんへ

    何度も申し訳ありません。


    http://q.hatena.ne.jp/1302757917
    ↑こちらで教えていただいた「置換を可変列」にしたランダム置換コードについて、
    教えてほしいことがあります。

    (処理結果としてかなり重要な部分なのですが、
    今になって気づいたことがありまして。)



    この「置換を可変列」にしたランダム置換コードなんですが、
    確かに重複しないランダム置換結果になります。

    ですが、
    例えば

    ※※※※※※※※※※※※※※※※※※※※※※※※※※※※
    エクセル(ランダム置換コード)を開く
      ↓
    【ランダム置換実行1回目】
    実行結果:猫はとてもカワイイ動物です。
      ↓
    【ランダム置換実行2回目】
    実行結果:犬はすごく愛らしい生き物です。
      ↓
    【ランダム置換実行3回目】
    実行結果:ラッコはすごくキュートなアニマルです。
      ↓
    エクセルを閉じる
    ※※※※※※※※※※※※※※※※※※※※※※※※※※※※

    上記のように
    複数回(今回は3回)ランダム置換してから、エクセルを閉じたとします。

    そして
    「再度」、同じエクセル(ランダム置換コード)を開いて同じ回数だけランダム置換してみます。
         ↓↓↓↓↓
         
    ※※※※※※※※※※※※※※※※※※※※※※※※※※※※
    エクセル(ランダム置換コード)を開く
      ↓
    【ランダム置換実行1回目】
    実行結果:猫はとてもカワイイ動物です。
      ↓
    【ランダム置換実行2回目】
    実行結果:犬はすごく愛らしい生き物です。
      ↓
    【ランダム置換実行3回目】
    実行結果:ラッコはすごくキュートなアニマルです。
      ↓
    エクセルを閉じる
    ※※※※※※※※※※※※※※※※※※※※※※※※※※※※


    前回と全く同じランダム置換結果にしかならないことがわかります。
    これはもちろん、
    「それぞれの(置換箇所)において」変換するデータがいくつもある場合なのですが、
    それでも何回やっても同じ結果になることがわかりました。

    ということは
    「極力重複しないランダム置換結果」がパターン化されているので、
    エクセルを起動するたびに、「極力重複しないランダム置換結果」自体が重複するコードということになります。


    そこでなんですが
    これまでの「エクセル表の形(見た目)を崩さずに」、「極力重複しないランダム置換結果」自体をパターン化することなく、
    実行するたびに新しい「極力重複しないランダム置換結果」を表示できるように修正していただけないでしょうか。

    なるべく同じ置換結果にはしたくないのです。
    違う置換結果になればなるほど、「重複しないランダム置換」ツールとしては精度が高まると思っています。


    この説明自体が入り組んでいて非常にわかりにくいので、もし伝わっていない部分などあれば
    うまく伝えられるまで何度でも説明させてください。




    -------------------------------------------------------------------------------------
    それから【補足】になるのですが、

    「検索結果を表示する列」の表示の仕方について、1つ、修正していただきたい部分があります。

    2回、3回、4回・・・と連続でランダム置換したいのですが、

    たとえば


    ※※※※※※※※※※※※※※※※※※※※※

    ※(動物)を置換するデータは「犬」だけとします。

    ①1回目の置換
    【置換前の文章】
    A2:(動物)
    A3:(動物)
    A4:(動物)
    A5:(動物)

      ↓↓↓

    【置換後の文章】を表示する列(の見え方)
    B2:犬
    B3:犬
    B4:犬
    B5:犬
    ※※※※※※※※※※※※※※※※※※※※※

    上のように1回置換してから、
    「置換前の文章」の行数を減らしてから立て続けに置換した場合


    ※※※※※※※※※※※※※※※※※※※※※
    ①2回目の置換
    【置換前の文章】
    A2:(動物)
    A3:(動物)
    A4:
    A5:

      ↓↓↓

    【置換後の文章】を表示する列(の見え方)
    B2:犬
    B3:犬
    B4:犬
    B5:犬
    ※※※※※※※※※※※※※※※※※※※※※

    上のように、
    「前の置換結果」に上書きする表示仕様になっています。


    そこでなんですが、上の例でいいますと


    ●1回目の置換
    【置換後の文章】を表示する列(の見え方)
    B2:犬
    B3:犬
    B4:犬
    B5:犬

    ↓↓↓

    ●2回目の置換
    【置換後の文章】を表示する列(の見え方)
    B2:犬
    B3:犬
    B4:
    B5:

    のように上書きしない仕様にしてほしいのです。
    (毎回置換直前に、「置換後の文章を表示する列」の「2行目以降」をクリアするようにしてほしいのです。)
    ---------------------------------------------------------------------------------------------


    Mookさん
    どうかよろしくおねがいします。

    何回も付き合わせてしまい、大変もうしわけないです。



    「新たに質問」しようとも思ったのですが、ここまでMookさんのコードありきで進ませていただいているので
    こういう形でお願いしようと思いました。


    このコメント欄にコードを載せていただいてもすごく嬉しいですが、
    もしMookさんが以前の私の質問に

    >コメントだと説明が見づらいので、こちらの回答に混ぜさせてもらいました。
    と書いたように、
    見やすさを重視して「コメント」欄より「回答」欄の方が書きやすいということであれば
    「新規に質問」登録させていただいても全然構いません。


    メッセージで少しポイントを送らせていただきましたが、プレッシャーになっていたら本当申し訳ありません。
    もしかしたら難しい変更(修正では済まない)かもしれないので、
    たとえ回答ができなくても(私が一方的に頼んでいることなので)、気になさらないで大丈夫です!


  • id:Mook
    コメント確認しました。

    後程、回答いたし増しますので、しばしお待ちください。
  • id:Mook
    まずランダムな数の扱いですが、初期化を行うことで回避ができます。
    ボタンの処理の直後に下記のように Randomize の行を入れてください。

    Private Sub CommandButton1_Click()
        Randomize


    2つ目の点ですが、
    >のように上書きしない仕様にしてほしいのです。
    というのは、元の文書がない部分を削除するという意味でよいのでしょうか。

    http://q.hatena.ne.jp/1302757917
    のコードで言えば、
    -----
      If resultCol = 0 Then
        MsgBox "「変換結果」の列がありません。"
        Exit Sub
      End If

      Dim CellA As Range
    -----
    の最後の行の前に1行(Cells(2,resultCol).Resize・・・・ の行)を追加してください。
    -----
      If resultCol = 0 Then
        MsgBox "「変換結果」の列がありません。"
        Exit Sub
      End If

      Cells(2,resultCol).Resize(Rows.Count-1,1).ClearContents

      Dim CellA As Range
    -----
    不明な点があれば、コメントください。
  • id:egaosaiko
    Mookさんへ

    お忙しい中
    本当にありがとうございます。

    「ランダム置換処理の初期化」と、「置換結果表示列の直前クリア」について教えていただき、すごく嬉しいです。
    言われた通り行を追加したら、完璧に動作しました。
    何度もチェックしましたが、希望通りの処理をしてくれます。

    重ね重ねありがとうございます。



    それから、
    >不明な点があれば、コメントください。
    これについて3つ聞いていただいてよろしいでしょうか。

    http://q.hatena.ne.jp/1302757917
    ↑のコードの「配列の単語を並べ替える」セクションでは

    >For i = 1 To 3 '// 気持ちだけ多めにシャッフル:省略も可。

    「気持ちだけ多めにシャッフル」とあります。
    この「シャッフル」は多ければ多いほど動作は重くなると思うのですが、
    シャッフルを増やすとランダム置換にどんな影響を与えるのでしょうか。


    またシャッフル回数の増やし方についてですが、

    For i = 1 To 3
    ↓↓↓
    For i = 1 To 4

    上のような変更("To"の後ろの数字の値を増加)でいいのでしょうか。





    それから、

    「ランダム置換前の文章」の行数が多かったり、「置換箇所」や「置換箇所を置換するデータ」が多いと
    もちろん、一回一回の処理が完了するまで時間がかかるのですが、
    「処理が完了したことを知らせる(知ることができる)ような工夫」にはどんなことがあると思いますか。

    ちなみに、今のところ

      '↓処理終了を知らせるメッセージボックス(あってもなくてもいい)の設定
      Dim WSH As Object
    Set WSH = CreateObject("WScript.Shell")
    WSH.Popup "1秒後、自動的に閉じます!", 1, "処理終了", vbInformation
    Set WSH = Nothing

       ↑のようなコードで、処理完了すると1秒間だけ知らせるような自動設定にしているのですが、
       正直1秒でも長いと感じています(立て続けに処理するときには、むしろ邪魔になっています)。

    そこでなんですが、
    立て続けに実行するときも邪魔しないで「処理完了を教えてくれる」ような、方法やコードなどもしあれば
    教えていただきたいのです。


    Mookさん
    もし時間ができたときにお答えいただけると、すごく助かります。
    どうかよろしくお願いいたします。
  • id:Mook
    全体の様子が分からないのですが、
    今現在どのくらい時間がかかっているのでしょうか。

    >気持ちだけ多めに
    の部分は正直不要だと思っています。
    トランプのカードを切るのと同じように、場所を入れ替えているのですが、
    すべての要素を一回は入れ替えています。
    その処理を3回繰り返しているので、論理的には1回でよいはずです。
    ですからその部分は
    Sub shuffleArray(wordArray)
      Dim r As Long
      r = UBound(wordArray)

      Dim i As Long, j As Long, s As Long, t As String
      For j = 0 To r
        s = Int(Rnd() * (r + 1))
        t = wordArray(s)
        wordArray(s) = wordArray(j)
        wordArray(j) = t
      Next
    End Sub
    で十分でしょう。

    ですが、全体の処理に対して、これがどの程度影響しているかは
    実際のデータで試してみないとわからない部分です。

    >立て続けに実行するとき
    というのが状況が分からないのですが、1行1行の処理のたびに先ほどのポップアップ
    を表示しているということでしょうか?

    実行の様子を教えていただけると、何かアイデアがあるかもしれません。
  • id:egaosaiko
    Mookさん

    返信ありがとうございます。

    時間は十分速いと思っています。
    100行でほぼ10秒くらいです。

    1文(1行)において「置換箇所」が20~30個あり、
    「置換箇所を置換するデータ」は多いものになると700データくらいあるので、
    この速さですごく満足しています。


    それからMookさんの説明を読んで、
    シャッフルの部分は、「今のところ」変更しないことに決めました。
    なんとなく気になっていたセクションでしたが納得できました。

    >ですが、全体の処理に対して、これがどの程度影響しているかは
    >実際のデータで試してみないとわからない部分です。
    ここは、何回もランダム置換して十分にデータを蓄積(10000行分など)してから
    「重複チェック」で何行分減少したかなどのテストが必要かと思っています。


    「立て続けに実行するとき」
    >というのが状況が分からないのですが、1行1行の処理のたびに先ほどのポップアップ
    >を表示しているということでしょうか?

    いえ、1行1行ずつではなく、「1列の処理が終わった後」にポップアップを1秒間表示するようにしています。
    ですので、実際はこんな細かいところまでこだわる必要はないのかもしれないのですが、
    どうせVBAを使うなら少しでも時間短縮できないものかと、つい質問してしまいました。

    今は、1列でだいたい150行処理くらいです。


    ランダム置換開始

    150行分の処理終了
    ポップアップを1秒間表示

    2回目のランダム置換開始

    150行分の処理終了
    ポップアップを1秒間表示

    3回目のランダム置換開始

    150行分の処理終了
    ポップアップを1秒間表示





    といった処理の順番です。
    もし行数を1000行などに増やした場合、「処理終了を知らせる工夫」があった方がいいのかな、とふと思ったのですが、

    なにかアイディアなどあればどうかよろしくお願いします。
  • id:Mook
    最後の部分ですが、同じ範囲に対して処理を繰り返しているということでしょうか。
    それとも同じようなデータセットが複数あってそれぞれを処理しているということでしょうか。

    こちらのイメージとしては1回の処理で完結するという感じがしていたので、ちょっとイメージが
    しづらい部分です。

    ポップアップは表示している間は、処理が止まってしまうので今の頻度だとよいかもしれませんが、
    あまり頻度が高いと、全体の性能に影響します。
    このような場合にはユーザフォームを使用してメッセージを出してはどうかと思います。

    ユーザフォームの作成は
    http://www.asahi-net.or.jp/~ef2o-inue/vba_k/sub04_080.html
    などが参考になると思いますが、
    VBE で 挿入 ⇒ ユーザフォーム
    表示された部分にラベル(Aのアイコン)を置きます。
    この状態で、標準モジュールで下記を実行してみてください。

    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Sub test()
      With UserForm1
        .Height = 80
        .Width = 300
        With .Label1
          .Top = 15
          .Left = 10
          .Height = 50
          .Width = 280
          .ForeColor = &HFF0000
          .Font.Size = 14
          .Caption = "メッセージです。"
        End With
        .Show vbModeless
        For i = 3 To 1 Step -1
          .Label1.Caption = "カウントダウン " & i
          DoEvents
          Sleep 800
        Next
      End With
      Unload UserForm1
    End Sub

    これだと処理中に常にステータスを表示しながら、処理を進めることが
    できます。

    このやり方がよいかどうかがまず第一判断ですが、これで効果があるようなら
    組み込み方は別途ご説明します。
  • id:egaosaiko
    Mookさん

    アイディアの提供ありがとうございます。

    >こちらのイメージとしては1回の処理で完結するという感じがしていたので、ちょっとイメージが
    >しづらい部分です。
    Mookさんのこのイメージであっています。
    私の説明が分かりにくくて申し訳ありません。

    正確には、「1回の処理」をただ複数回している(コマンドボタンを複数回押している)だけです。
    >同じ範囲に対して処理を繰り返しているということでしょうか。
    この通りです。


    ランダム置換開始(コマンドボタンを押す)

    150行分の処理終了(ポップアップを1秒間表示)

    2回目のランダム置換開始(再度コマンドボタンを押す)

    150行分の処理終了(ポップアップを1秒間表示)

    3回目のランダム置換開始(再再度コマンドボタンを押す)

    150行分の処理終了(ポップアップを1秒間表示)





    上のような感じならイメージしやすいでしょうか。



    ユーザフォームの扱いは初めてだったので、かなり苦戦しましたが、
    なんとか実行できました。
    すごく良さそうな気がします。
    ありがとうございます。

    >このやり方がよいかどうかがまず第一判断ですが、これで効果があるようなら
    >組み込み方は別途ご説明します。
    もっとどうなるのか知りたいので、
    組み込み方の説明をどうかよろしくお願いします。

  • id:Mook
    処理が連続して複数回されるのでなければ、表示はそれほど重要性は
    無いような気がしてきました。

    なぜ複数回実行するかのあたりを説明いただけるでしょうか。
    全体の目的と操作を説明してもらえると、そちらの方が改善の余地があるような気がします。

    連続してボタンを押すのであれば、そもそも処理そのものを繰り返し実行できます。
    ですが、結果を上書きしてしまうので、なぜ繰り返し実行するかの目的が不明です。

    ちょっと遅くなったので、続きは明日見させてもらいます。
  • id:egaosaiko
    Mookさんへ

    お返事ありがとうございます。


    いかに重複しない(パターン化されない)置換を実現できるか、というのが一番の目的だったので
    実をいうと、昨晩「ランダム置換処理の初期化」の修正をしていただいた時点でとりあえず目的は達成できています。

    試しに、
    一つの文章を2万行分ランダム置換してみましたが、重複する文章は一つもありませんでした。
    置換されたデータに偏りがあるか、などのチェックはまだしていませんが今の時点では十分満足しています。

    ですので、
    >処理が連続して複数回されるのでなければ、表示はそれほど重要性は
    >無いような気がしてきました。
    一言でいうと、ほとんど意味がなかったりします。
    ただ、

    ランダム置換開始(コマンドボタンを押す)

    150行分の処理終了(ポップアップを1秒間表示)

    2回目のランダム置換開始(再度コマンドボタンを押す)

    150行分の処理終了(ポップアップを1秒間表示)

    3回目のランダム置換開始(再再度コマンドボタンを押す)

    150行分の処理終了(ポップアップを1秒間表示)





    のような複数回の処理を行ったのは、
    「重複チェックするために」多くのランダム置換結果がほしかったからなのですが、
    冷静に考えて、(かなり恥ずかしいのですが)そんな手間のかかることしないで、
    「置換したい文章」を「置換したい行分だけコピー」してコマンドボタンを1回押せば済むことでした!

    「ランダム置換結果を上書き」しない仕様については
    単純に私の気分的なものなので(自己満足ということになりますので)、とりわけ深い理由というのはありません。


    そんなわけで、現時点で手を加えるところはいよいよ見当たらないので
    「よりパターン化を抑えたランダム置換」に近づくための機能として取り入れたい部分が出てくるまで、
    またはエラーや不具合が見つかるまでは

    現時点の「極力重複しないランダム置換ツール」を、暫定完成形とさせていただくことにします。

    これもMookさんのおかげとしか言いようがありません。
    本当にありがとうございます。


    「処理そのものを繰り返し実行」したくなったら、
    処理しながらユーザフォームでメッセージを出す方法(組み込み方)も教えていただきたくなると思います。

    そのときは、どうかまたよろしくお願いいたします。
    (Mookさんがおっしゃるように、それほど重要性がない機能を無理して付ける必要もないと思うので、
    ユーザフォームの部分は持ち越しという形でお願いしたいです。)


    Mookさん
    お忙しい中、深夜まで付きあわせてしまい、ほんとうに申し訳ありません。
    ありがとうございます。

  • id:Mook
    不要との結論になったようですが、せっかくですからやり方だけ説明しておきます。
    何かの際に参考にしてください。

    昨日追加した削除の列の後ろに下記を変更してみてください。
    ---------------------
      Cells(2, resultCol).Resize(Rows.Count - 1, 1).ClearContents
      
      Application.ScreenUpdating = False
      Application.Calculation = xlCalculationManual
      
      '// ユーザフォームの初期設定
      With UserForm1
        .Height = 80
        .Width = 300
        With .Label1
          .Top = 15
          .Left = 10
          .Height = 50
          .Width = 280
          .ForeColor = &HFF0000
          .Font.Size = 14
        End With
        .Show vbModeless
      End With
      
      Dim lastRow As Long
      lastRow = dstWS.Cells(Rows.Count, sourceCol).End(xlUp).Row
      
      Dim CellA As Range
      Dim res As String
      Dim i As Long
      Set CellA = dstWS.Range(dstWS.Cells(2, sourceCol).AddressLocal)
      Do While CellA.Value <> ""
      '// ユーザフォームのメッセージ
        UserForm1.Label1.Caption = CellA.Row - 1 & " / " & lastRow - 1 & "処理中です。"
        DoEvents
        
        res = CellA.Value
        For i = LBound(replaceArray) To UBound(replaceArray)
          res = replacePhrase(res, searchWord(i), replaceArray(i))
        Next
        dstWS.Cells(CellA.Row, resultCol).Value = res
        Set CellA = CellA.Offset(1, 0)
      Loop
      
      '// ユーザフォームの処理終了
      Unload UserForm1
      Application.Calculation = xlCalculationManual
      Application.ScreenUpdating = False
      MsgBox "処理が終了しました"
    End Sub
    ---------------------
    ですが、じつは UserForm1 のほとんどの部分は最初にデザインで設定しておけば不要な
    部分ですので、Show 以外は省略も可能です。

    私の方では100行でやってみましたが、ほとんど一瞬だったので役に立ちませんでしたが・・・。
  • id:egaosaiko
    Mookさんへ

    処理中のユーザフォームの組み方(コード)、
    教えていただいてありがとうございます。

    今すぐには使う予定はないのですが、
    今後必要になるかもしれないので
    テキストファイルにコピーして保存させていただきました。


    Mookさん
    またコメントなどさせていただいた際には、
    どうかよろしくおねがいします。
  • id:Mook
    下記の部分が誤っていたので、修正しておいてください。
    ~~~~~~~~~~
      Application.ScreenUpdating = False
      Application.Calculation = xlCalculationManual
        :
       処理
        :
      Application.Calculation = xlCalculationAutomatic '// ★★修正
      Application.ScreenUpdating = True '// ★★修正
    ~~~~~~~~~~

    蛇足ですがUserForm とは関係なく、上記の4行は速度の改善になるかもしれません
    ので、試してみるとよいかもしれません。

    多くのポイントありがとうございました。
  • id:egaosaiko
    Mookさん

    修正のご連絡ありがとうございます。


    >蛇足ですがUserForm とは関係なく、上記の4行は速度の改善になるかもしれません
    >ので、試してみるとよいかもしれません。

    これはユーザフォームを使わない場合でも、挿入しておいた方がいい4行なのでしょうか。
    ユーザフォームを使わない場合は、その間の処理のコードも存在しないため、
    挿入する必要はない4行と考えているのですが、この解釈で合っていますでしょうか。

    どうかご回答をよろしくおねがいします。

  • id:Mook
    マクロは良く分からない部分が多いかもしれませんが、だいたいでよいので
    コードの内容は理解するようにされた方がよいかと思います。
    そうすれば、いずれはご自身でマクロを作成できるようになるでしょう。

    上記のコードは自動計算と、画面更新の処理を処理中停止するためのもので、
    ユーザフォームとはまったく関係ないものです。
    特に計算式が多数あったり、セルの更新が多数ある場合に効果があります。

    マクロの処理に時間がかかるという際に使われる典型的な制御なので、
    覚えておくとよいと思います。

  • id:egaosaiko
    Mookさん

    丁寧にありがとうございます。

    >ユーザフォームを使わない場合は、その間の処理のコードも存在しないため、
    >挿入する必要はない4行と考えているのですが、この解釈で合っていますでしょうか。
    「その間の処理のコード」がちゃんと存在するのに、
    確認しないで聞いてしまいました。
    不可解な質問になってしまい申し訳ありません。

    修正したところ「劇的に速く」なりました。
    有用な情報、本当にありがとうございます。
    勉強させていただき嬉しいです。

      
    >だいたいでよいので
    >コードの内容は理解するようにされた方がよいかと思います。
    >そうすれば、いずれはご自身でマクロを作成できるようになるでしょう。
    おっしゃる通りです。
    恥ずかしいですが、今の時点で基本さえかなり曖昧です。
    計算ドリルなどのコードを書くところから、勉強してみたいと思います。

    アドバイスありがたいです。
  • id:egaosaiko
    Mookさんへ

    わざわざ来ていただき、ありがとうございます。


    ランダム置換したいデータが、
    URLやHTMLタグの場合でも1つの置換データとして扱える仕様にしていただきたいのです。


    今のコードですと、

    ランダム置換したいデータが
    例えば


    http://a.com/
    <a href="http://a.com/">何かの文章など</a><br>
    <a href="http://a.com/"><img src="http://image.a.com/b"></a><br>


    ↑のようにURLやHTMLタグの場合、
    実際に置換してみると、


    http:
    <a href="http:
    a.com
    image.a.com


    ↑のように、
    置換結果が一部だけ表示される仕様のようなのです。





    現在のコードです。
    ↓↓↓



    Option Explicit

    '// コマンドボタン処理
    '//-----------------------------------
    Private Sub CommandButton1_Click()
    Randomize
    Dim dstWS As Worksheet
    Set dstWS = ThisWorkbook.Sheets("Sheet1")

    Dim replaceArray() As Variant
    Dim searchWord() As Variant

    Dim rCount As Long
    rCount = 0

    Dim sourceCol
    sourceCol = 0

    Dim resultCol
    resultCol = 0

    Dim c As Long
    For c = 1 To Columns.Count
    If InStr(dstWS.Cells(1, c).Value, "置換") > 0 Then
    ReDim Preserve replaceArray(rCount)
    ReDim Preserve searchWord(rCount)
    replaceArray(rCount) = makeArray(dstWS.Range(dstWS.Cells(3, c).AddressLocal))
    searchWord(rCount) = dstWS.Cells(2, c).Value
    rCount = rCount + 1
    End If
    If InStr(dstWS.Cells(1, c).Value, "入力文") > 0 Then
    sourceCol = c
    End If
    If InStr(dstWS.Cells(1, c).Value, "変換結果") > 0 Then
    resultCol = c
    End If
    Next

    If sourceCol = 0 Then
    MsgBox "「入力文」の列がありません。"
    Exit Sub
    End If
    If resultCol = 0 Then
    MsgBox "「変換結果」の列がありません。"
    Exit Sub
    End If

    Cells(2, resultCol).Resize(Rows.Count - 1, 1).ClearContents

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim CellA As Range
    Dim res As String
    Dim i As Long
    Set CellA = dstWS.Range(dstWS.Cells(2, sourceCol).AddressLocal)
    Do While CellA.Value <> ""
    res = CellA.Value
    For i = LBound(replaceArray) To UBound(replaceArray)
    res = replacePhrase(res, searchWord(i), replaceArray(i))
    Next
    dstWS.Cells(CellA.Row, resultCol).Value = res
    Set CellA = CellA.Offset(1, 0)
    Loop

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

    End Sub

    '// 配列を使用してランダムに置き換え
    '//-----------------------------------
    Function replacePhrase(phrase, searchWord, replaceArray)
    Dim pArray As Variant
    Dim arrayIndex As Long
    Dim i As Long

    '// 配列のシャッフル
    arrayIndex = 0
    shuffleArray replaceArray
    pArray = Split(phrase, searchWord)
    replacePhrase = pArray(0)
    For i = 1 To UBound(pArray)
    replacePhrase = replacePhrase & replaceArray(arrayIndex) & pArray(i)
    arrayIndex = arrayIndex + 1
    If arrayIndex > UBound(replaceArray) Then
    '// 一巡したら配列を再シャッフル
    arrayIndex = 0
    shuffleArray replaceArray
    End If
    Next
    End Function

    '// 指定したレンジから配列に作成
    '//-----------------------------------
    Function makeArray(baseRange As Range)
    Dim r As Range
    Dim res As String

    res = baseRange.Value
    Set r = baseRange.Offset(1, 0)

    Do While r.Value <> ""
    res = res & "/" & r.Value
    Set r = r.Offset(1, 0)
    Loop
    makeArray = Split(res, "/")
    End Function

    '// 配列の単語を並べ替える
    '//-----------------------------------
    Sub shuffleArray(wordArray)
    Dim r As Long
    r = UBound(wordArray)

    Dim i As Long, j As Long, s As Long, t As String
    For i = 1 To 3 '// 気持ちだけ多めにシャッフル:省略も可。
    For j = 0 To r
    s = Int(Rnd() * (r + 1))
    t = wordArray(s)
    wordArray(s) = wordArray(j)
    wordArray(j) = t
    Next
    Next
    End Sub



    もし可能でしたら、コードの修正をお願いしたいです。

  • id:Mook
    コメント確認しました。
    ポイントありがとうございました。

    内容はもうすかっり忘れてしまったので、確認の上夜にでもコメントします。
    しばし、お待ちを。
  • id:Mook
    内容をあまり思い出せませんが(´-∀-`;)、
      原因は結合と分割に / を使っているためだと思います。
    makeArray の中を

      Do While r.Value <> ""
        res = res & "/" & r.Value
        Set r = r.Offset(1, 0)
      Loop
      makeArray = Split(res, "/")

    から

      Do While r.Value <> ""
        res = res & "{/}" & r.Value
        Set r = r.Offset(1, 0)
      Loop
      makeArray = Split(res, "{/}")
    のように実際に処理データのない文字(複数でもOKです)にしたら、
    どうでしょうか。

    ご確認ください。
  • id:egaosaiko
    Mookさんへ

    返信が大変遅くなってしまい、申し訳ありません。

    コメントしていただき、
    本当にありがとうございます。

    一度忘れていることを思い出すという、時間のかかることをしていただき
    大変ありがたいです。



    確認させていただきました。


    教えていただいた
    修正場所と、修正コードの通りでうまく置換されるようになりました。

    おかげさまで、またこのエクセルツールの精度が上がりました。


    Mookさん
    お時間をとっていただき、重ね重ねありがとうございます。

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

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

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

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