VBAでプログラムコードを大小いくつか作成しましたが，あまり自信がないのですが添削してもらえる窓口サイトを教えてください．

Question

Sub 新漢字検索_総合() 'Used ***********************************************

' MsgBox "新たに作り直す"

 Dim ssr As Long, ssc As Long, sk As Variant

 Dim Jobflag As Variant, Outofset As Long

 ssr = 3 '検索データの場所

 ssc = 3

 sk = Cells(ssr, ssc).Value

 Outofset = 100

 Jobflag = 0

 新\_漢字\_検索方法1\_2\_3両方 ssr, ssc, sk, Jobflag, Outofset
```End Sub

Sub 新\_漢字\_検索方法1\_2\_3両方(ssr, ssc, sk, Jobflag, Outofset)

Dim rng As Range, Srng As Range, P_Address As String ' 最初に見つかったセルのAddress

Dim C1 As Long, C2 As Long, Pr As Long, pc As Long

Dim Eflag As Long, cnt As Long, skf As Long, flag0 As Long, flag1 As Long '検索結果

Dim Job As Variant, Job1 As Variant, Book_n As String, shn As String, Rshn As String, 抽出先rng, path As String

Dim cpi As Long, TcT As Long, m_Category As Long, w_flag1 As Long, w_flag2 As Long, ofset As Long

Dim OutR As Long, OutC As Long, i As Long, JobX As Variant, Jobfx As Long, Jp As Variant

Dim Judge As Variant

m_Category = Cells(5, 2).Value

ofset = 3

Book_n = ActiveWorkbook.Name

shn = ActiveSheet.Name

Rshn = "検索結果Sh"

path = ActiveWorkbook.path ' Fullname & Book_n

cnt = 0

C1 = 2: C2 = m_Category * 4 + 1: cpi = 0 '範囲左端右端：フィールド行:パターン設定値

Erase Seach_Dim: Erase Seach_Dim漢字列: Erase min漢

OutR = 4: OutC = 4 '出力先の左上

Set 抽出先rng = Range(Cells(5, OutC), Cells(104, 9))

w_flag1 = 0: w_flag2 = 0 '検索された最初の1,2個用flag共に初期値=0,一度通過すると1です.

   Inisial\_work\_Common Job, Book\_n, shn, Rshn, rng, C1, C2, ssr, ssc, cpi, sk, skf, 抽出先rng, OutR, OutC

   If skf = 9 Then

Cells(ssr, ssc).Select

MsgBox "検索値が入力されていません."

Exit Sub

'検索対象があるかまたはいくつあるか調べる

   Workbooks(Book\_n).Worksheets(shn).Activate

   cnt = 0

   rng.Select

   Set rng = Range(Cells(StartRow + 1, C1), Cells(D\_max, C2))  '検索範囲

   Set Srng = rng.Find(what:=sk, LookIn:=xlValues, \_

            LookAt:=xlWhole, MatchCase:=False, MatchByte:=False)

 MsgBox sk & "は,見つかりません,登録されていません." & Chr(10) & \_

"検索文字に間違いがあれば,訂正して再度実行してください."

Workbooks(Book\_n).Worksheets(shn).Activate

Application.ScreenUpdating = True

Cells(ssr, ssc).Select

Exit Sub

End If

'最初の検索結果のアドレスを格納/　　　皆通る

Range(Srng.Address).Select '最初を選択

P_Address = Srng.Address '代入アドレスPに代入

cnt = 1 '1個目

If min漢(1, 1) > 0 And cnt = 1 And w_flag1 = 1 Then

Else

    Pr = ActiveCell.Row

    pc = ActiveCell.Column

    min漢(1, 1) = Pr

    min漢(1, 2) = pc

    min漢(1, 3) = Cells(Pr, pc).Value

    w\_flag1 = 1

End If

Do

'次の検索を実行

Set Srng = rng.FindNext(After:=Srng)

      '対象文字の操作のためたプロシ-ジャ呼び出し

     Srng.Select

     If Srng.Address = P\_Address Then    '1個も3以上の複数の場合終わり抜ける

            Exit Do

'                     Exit Do

     ElseIf cnt = 2 And w\_flag2 = 1 Then  ' 2個を抜ける

     End If

            Range(Srng.Address).Select

            cnt = cnt + 1

            If w\_flag2 = 1 And min漢(2, 1) > 0 And cnt > 2 Then

            Else '2個め取得

                Pr = ActiveCell.Row

                pc = ActiveCell.Column

                min漢(2, 1) = Pr

                min漢(2, 2) = pc

                min漢(2, 3) = Cells(Pr, pc).Value

                w\_flag2 = 1

            End If

Loop 'Until Srng.Address = P_Address

'Stop

   If cnt > 100 Then

MsgBox "検索文字; " & sk & " の登録/検索数が多く,100 以上あります. " & cnt & Chr(10) & _

"このシステムでは,配列数や書き出し範囲上限界です." & Chr(10) & _

"検索文字を変更して最初からやり直してください,一時中止します."

Workbooks(Book_n).Worksheets(shn).Activate

Cells(ssr, ssc).Select

Exit Sub

'      SearchM1 rng, C1, C2, ssr, ssc, sk, cnt, Eflag, Pr, pc

MsgBox "検索数は," & cnt & "個です.その場所のパターンを黄色で示します."

Workbooks(Book_n).Worksheets(shn).Activate

Application.ScreenUpdating = True

Cells(min漢(1, 1), min漢(1, 2)).Select

Selection.Interior.ColorIndex = 6

  JobX = InputBox("検索結果は," & sk & "これ1つです" & Chr(10) & \_

  " 1...ここに止まり修正する" & Chr(10) & \_

  " 2...確認しただけで次の別の検索を行います", "job set", 2)

  If JobX = "" Or JobX = 0 Then

      Cells(3, 3).Select

      Exit Sub

  ElseIf JobX = 1 Then

     Cells(min漢(1, 1), min漢(1, 2)).Select

     Selection.Interior.ColorIndex = 0

  Else

      Application.ScreenUpdating = True

      Cells(ssr, ssc).Select

      Exit Sub

  End If

ElseIf cnt = 2 Then

     Jp = InputBox("最初の検索位置か,2番目の位置のどちらかにとどまり検索は終わります." & Chr(10) & \_

    "1...最初の位置　" & Chr(10) & \_

    "2...2番目の位　" & Chr(10) & \_

    "3...検索を終わる", "JobSet", 2)

    If Jp = "" Or Jp = 0 Then

        Cells(3, 3).Select

    ElseIf Jp = 1 Then

       Cells(min漢(1, 1), min漢(1, 2)).Select

    ElseIf Jp = 2 Then

       Cells(min漢(2, 1), min漢(2, 2)).Select

    Else

       MsgBox "検索は終わります."

       Workbooks(Book\_n).Worksheets(shn).Activate

       Cells(ssr, ssc).Select

       GoTo Last\_work

Exit Sub

    End If

ElseIf 3 <= cnt Then

    MsgBox "最後まで検索は終わりました.検索文字; " & sk & " は," & cnt & " 個有りました." & Chr(10) & Chr(10) & \_

    "検索数が多い場合は,続けて一覧表へ書き出し作業を行います,その結果では,確認したい場所の行番号に移動するボタンでジャンプできます." & Chr(10) & \_

            "作業は,そちらの指示に従って下さい."

    Job = 3 '漢字列検索専用書き出し方式/特定の範囲検索をします"

    列単位に検索する\_続ける\_カラーセット Book\_n, shn, Rshn, rng, Job, sk, m\_Category, ofset, C1, C2, ssr, ssc, Pr, pc, Eflag, OutR, OutC

Else

End If

Last\_work:

Application.ScreenUpdating = True

MsgBox Mesage5

'3 　\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*

'                                         Book\_n , shn, Rshn, rng, Job, sk, m\_Category, ofset, C1, C2, ssr, ssc, Pr, pc, Eflag, OutR, OutC

Sub 列単位に検索する\_続ける\_カラーセット(Book\_n, shn, Rshn, rng, Job, sk, m\_Category, ofset, C1, C2, ssr, ssc, Pr, pc, Eflag, OutR, OutC)

Dim 抽出先rng As Range, Sr1 As Long, Sc1 As Long, Ca As Long

Dim Srng As Range, P_Address As String, pp As Long, lr As Long

Dim Job1 As Variant, Judge As Variant, cpi As Long, w_flag As Long, i As Long

Dim cnt As Long

Workbooks(Book_n).Worksheets(shn).Activate

cnt = 0

For i = 1 To m_Category

pp = (i - 1) * 4 + ofset

lr = Cells(D_max, pp).End(xlUp).Row

Range(Cells(StartRow + 1, pp), Cells(lr, pp)).Select

Set rng = Range(Cells(StartRow, pp), Cells(lr, pp))

Set Srng = rng.Find(what:=sk, LookAt:=xlPart) '最初はFind検索

If Srng Is Nothing Then '無い場合の処理*********

       Eflag = 0

       GoTo スキップ

Else

    '最初の検索結果のアドレスを格納

Range(Srng.Address).Select  'Srng.Activate

P\_Address = Srng.Address    '代入アドレス

Pr = ActiveCell.Row

pc = ActiveCell.Column

Cells(Pr, pc).Select  '↑と同じこと

cnt = cnt + 1

GoSub 配列設定

End If

    Do  '次の検索を実行

        Set Srng = rng.FindNext(After:=Srng)  'RangeのFindNextの引数Afterに,戻り値Srngにセットする/その次から検索継続する..Activate

             If Srng.Address = P\_Address Then  '最初と同じ場合

                If cnt > 0 Then   'カウントが1個以上である

                    cnt = cnt

                    Eflag = 1

                Else

                    Eflag = 9

                End If

                Exit Do

             Else

             Range(Srng.Address).Select  '次の地点

             cnt = cnt + 1   '積算増加

             GoSub 配列設定

          End If

    Loop

Next i

  If Job = 1 Then

MsgBox "検索結果は，一覧表に黄色いパターンで表示されています."

Sheets(Rshn).Select

Cells(OutR - 1, OutC + 3).Value = sk

GoSub 結果書き出し

Sheets(Rshn).Select

Cells(OutR - 1, OutC + 3).Value = sk

GoSub 結果書き出し

Sheets(Rshn).Select

Cells(OutR - 1, OutC).Select

Application.ScreenUpdating = True

Exit Sub

配列設定:    '列単位で検索する時

            Seach\_Dim(cnt, 1) = Srng.Address        '１アドレス

            Seach\_Dim(cnt, 2) = ActiveCell.Row      '2 Row

            Seach\_Dim(cnt, 3) = ActiveCell.Column   '3 column

            Seach\_Dim(cnt, 4) = Cells(StartRow, ActiveCell.Column)     '4カテゴリ

            Seach\_Dim(cnt, 5) = Srng                '5セル内容

            Cells(Seach\_Dim(cnt, 2), Seach\_Dim(cnt, 3)).Select

            Selection.Interior.ColorIndex = 6

結果書き出し:

Workbooks(Book_n).Worksheets(Rshn).Activate

For i = 1 To cnt

  Cells(OutR + i, OutC).Select

  Cells(OutR + i, OutC).Value = Seach\_Dim(i, 1)  'addoress

  Cells(OutR + i, OutC + 1).Select

  Cells(OutR + i, OutC + 1).Value = Seach\_Dim(i, 2)  'Pr

  Cells(OutR + i, OutC + 2).Select

  Cells(OutR + i, OutC + 2).Value = Seach\_Dim(i, 3)  'Pc

  Cells(OutR + i, OutC + 3).Select

  Cells(OutR + i, OutC + 3).Value = Seach\_Dim(i, 4)  'Catrgori

  Cells(OutR + i, OutC + 4).Select

  Cells(OutR + i, OutC + 4).Value = Seach\_Dim(i, 5) 'セル内容

Next

End Sub

Answer 1

デバッグモードやブレークポイントなどを駆使して、

中間状態の変数やオブジェクトの内容を確認すれば意図した内容かどうかは一目瞭然な筈です。

思うではなく、具体的に確認しましょう。

Answer 2

確かに思い通りになればよいですが，Findがどのような動きをしているのかわからないのでまたアルゴリズムが分かっていないので書き方に間違いがあることもあります．特に検索数が1つの場合と複数の場合で動きが異なるように思います．確かに1周検索を行い最初の場所に戻れば終わりとは分かっています．

　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　以上

Answer 3

英語では質問が不可能ですので結構です．

Answer 4

> 添削してもらえる窓口サイト

添削という表現が微妙ですが、基本的にあなたが意図した動作をしていればＯＫではないですか？

そのプロセスにおいてマクロの記述方法は人様々です。（一つの書き方だけが正解とは限りません。）

意図した挙動になっていない、エラーなどを克服出来ないなどの場合は、

その詳細情報などを添えて海外コミュニティで聞いてみれば良いのでは無いでしょうか？

Answer 5

VBA(マクロ)の公式サポート場所は、海外コミュニティとなっています。

有識者が集まっている所の方が、適切なアドバイスを受けやすいでしょう。

・Stack Overflow(VBA)

　　[VBA プログラミングに関する質問]

　　Stack Overflow には、説明的なタイトル、完全で簡潔な問題ステートメント、問題を再現する
　　ための十分な詳細の要求などのガイドラインがあることに注意してください。
　　機能要求または過度に広範な質問は、トピック外と見なされます。
　　新しいユーザーの場合は、Stack Overflow ヘルプ センター にアクセスして詳細を確認して下さい。

※ 閲覧者・回答者が多い公式サポートサイトをお勧めします。

　 英語で質問を送信してください。