Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Home : Excel 2013)
コピーデータが貼りつかないのですが?
投稿日時: 19/03/25 20:31:06
投稿者: モリチャン

電気試験の規格と条件を、EXCELデータとし、信頼性試験のグラフブックの規格表に貼り付け、EXCELでグラフ作成をしようと思います。コンセプトは、フォーム上で規格表データを読み込み、グラフ表も読み込み貼り付ける方法です。グラフ表のデータを始めクリアし、それから、規格条件データを貼り付けます。クリヤはできています。試験項目は40くらいあるのですが、それを、テキストボックスで10個くらい指定し、そのデータだけ貼り付けます。フォームのコードは、完全の様で、グラフブックと、規格データブック名は、Fileに入っています。
モジュールのロジックは良いと思うのですが、モジュール部をF8で動かせる解析すると、変数Iは、1までしか動かず、D,Data(dfile)は、データが入りません。モジュール部で問題ないでしょか。
 1)kは動くが、iが、Len関数が効いていないのか、1以外変化しない。iに対するLenの使い方はこれで良いのでしょうか? (Cells find以下が動いていなくて、Copyができないようなので)
 2)dfilename(1)が入っていないがDataに読み込ませる方法は無いでしょうか?TEXTNOも変数宣言してみました。
 3)D=Val(mid)関数だが、これで動くのでしょうか?
 規格転送は、オブジェクト名です。
Sub dialog_show()
規格転送.規格ファイル = ""
規格転送.送られ側 = ""
規格転送.Show
If Button = "ok" Then Call main
 End Sub
 
 Sub main()
Dim sinn
Dim i
Dim k
Dim Data
Dim D
Workbooks.Open Filename:=gfilename(1)
sinn = ActiveWorkbook.Name
Sheets("規格値").Select
Range("E10").Select
ActiveCell.Offset(0, 0).Range(Cells(1, 1), Cells(15, 7)).Select ’データを貼り付ける領域
Selection.ClearContents
 
For k = 1 To 7
For i = 1 To i = Len(TESTNO) / 2 'Test項目数
 
Workbooks.Open Filename:=dfilename(1)
Data = ActiveWorkbook.Name
Windows(sinn).Activate
Range("E10").Select
ActiveCell.Offset(k - 1, i - 1).Select
Windows(Data).Activate
D = Val(Mid(TESTNO, (i - 1) * 2 + 1, 2)) 'Test項目の番号
Cells.Find(What:="D", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
.Activate
ActiveCell.Offset(k - 1, 0).Copy
Windows(sinn).Activate
Selection.PasteSpecial Paste:=xlFormula
Next i
 
Next k
 
ActiveWindow.Close
If k = 7 Then
Application.ScreenUpdating = True
MsgBox ("終了しました")
End If
 
 End Sub

回答
投稿日時: 19/03/25 21:13:57
投稿者: simple

まず、インデントをしっかりつけることと、すべての変数の宣言をすることを推奨します。
 

For i = 1 To i = Len(TESTNO) / 2 'Test項目数 
ですが、この意図するところを説明してください。
TESTNOは数値変数ですか?
そのLenとは?少なくとも
For i = 1 To Len(TESTNO) / 2
じゃないんですか?
まずそのあたりの説明をして下さい。

回答
投稿日時: 19/03/25 22:14:37
投稿者: WinArrow
投稿者のウェブサイトに移動

↓のスレと関係すると思いますが
 
https://www.moug.net/faq/viewtopic.php?t=78034
 
こちrは、どのようになったのでしょうか?

回答
投稿日時: 19/03/26 14:58:13
投稿者: Suzu

引用:
試験項目は40くらいあるのですが、それを、テキストボックスで10個くらい指定し、そのデータだけ貼り付けます。

 
その動作は、提示頂いたコードのどこに反映されているのでしょうか。
それとも、反映されていない?
 
 
引用:
フォームのコードは、完全の様で、

ここでおっしゃっている「完全」とは・・・? コードとして問題ない という意味でしょうか?
 
フォームのクラスモジュール?
引用:
Sub dialog_show()
  規格転送.規格ファイル = ""
  規格転送.送られ側 = ""
  規格転送.Show
  If Button = "ok" Then Call main
End Sub

この事でしょうか?
 
 
引用:
グラフブックと、規格データブック名は、Fileに入っています。

このFile とは何ですか? 変数名?(gfilename(1)、dfilename(1) ?)
 
 
 
とりあえず、Activate、Select や Selection の部分を省略してみました。
Sub main()
  Dim i As Long
  Dim k As Long
  Dim D As Variant

  Dim wbk0 As Workbook
  Dim wbk1 As Workbook

  Dim rng As Range

  Set wbk1 = Workbooks.Open(Filename:=dfilename(1))
  Set wbk0 = Workbooks.Open(Filename:=gfilename(1))
  wbk0.Worksheets("規格値").Range("E10").Offset(0, 0).Range(Cells(1, 1), Cells(15, 7)).ClearContents

  For k = 1 To 7
    For i = 1 To i = Len(TESTNO) / 2 'Test項目数

      D = Val(Mid(TESTNO, (i - 1) * 2 + 1, 2)) 'Test項目の番号
      Set rng = wbk1.Cells.Find(What:="D", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
      If Not rng Is Nothing Then
        rng.Offset(k - 1, 0).Copy
        wbk0.Worksheets("規格値").Range("E10").Offset(k - 1, i - 1).PasteSpecial Paste:=xlFormula
      End If
    Next i
  Next k

  wbk1.Close SaveChanges:=False
  Application.ScreenUpdating = True
  MsgBox ("終了しました")
End Sub

 
 
引用:
Len関数が効いていないのか、1以外変化しない

    For i = 1 To i = Len(TESTNO) / 2 'Test項目数
 
この評価の意味は理解されていますか?
i = Len(TESTNO)
TESTNO が 何にしても、 LENでは文字数を数えていて、その文字数と i を = で比較
比較結果としては、True(-1) または、False(0) なので
 
 i は、1 から、 (-1/2 または 0/2) の範囲で繰り返し
つまり
 
 i は、1 から -1/2
 または
 i は 1 から 0 のくり返し。
 
なので、i は 繰り返していないです。
 
どうすれば良いか?
この条件式をどんな意図で使っているのか判らないので、どんな式にしたら良いのか回答者には判りません。
 
 
引用:
dfilename(1)が入っていないがDataに読み込ませる方法は無いでしょうか?TEXTNOも変数宣言してみました。

 
ここでいうData とは何ですか?
 
 
引用:
D=Val(mid)関数だが、これで動くのでしょうか?

動作するか? 動作はしますよね。
意図する結果が得られているのかは、質問者さんが何をしたいのかが判りませんので
どうすれば 意図する結果が得られるのかは分かりません。

投稿日時: 19/03/26 20:50:49
投稿者: モリチャン

simple さんの引用:
まず、インデントをしっかりつけることと、すべての変数の宣言をすることを推奨します。
 
For i = 1 To i = Len(TESTNO) / 2 'Test項目数 
ですが、この意図するところを説明してください。
TESTNOは数値変数ですか?
そのLenとは?少なくとも
For i = 1 To Len(TESTNO) / 2
じゃないんですか?
まずそのあたりの説明をして下さい。

 
この目的は、070925303133というような2桁のtestナンバーから、2分の1にすることで数を数えてテスト項目数を見つけようとしています。例の時は6個です。どうもこのTESTNOが入っていません。
今はフォームの最終ボタンを押すと、動きだすと(他のデータに追加でtestnoが入る)と思うのですが、1舜で終わり分析できないと思います。今は目的の処理できません

投稿日時: 19/03/26 21:12:52
投稿者: モリチャン

Suzu さんの引用:
引用:
試験項目は40くらいあるのですが、それを、テキストボックスで10個くらい指定し、そのデータだけ貼り付けます。

 
その動作は、提示頂いたコードのどこに反映されているのでしょうか。
それとも、反映されていない?
 
 
引用:
フォームのコードは、完全の様で、

ここでおっしゃっている「完全」とは・・・? コードとして問題ない という意味でしょうか?
 
フォームのクラスモジュール?
引用:
Sub dialog_show()
  規格転送.規格ファイル = ""
  規格転送.送られ側 = ""
  規格転送.Show
  If Button = "ok" Then Call main
End Sub

この事でしょうか?
 
 
引用:
グラフブックと、規格データブック名は、Fileに入っています。

このFile とは何ですか? 変数名?(gfilename(1)、dfilename(1) ?)
 
suzuさん
 
質問有難うございます。
始めの、規格転送〜は、規格転送というオブジェクトフォームのテキストボックスを初期化して、規格ファイル名と送られ側に、グラフファイル名が入るようにしています。Lenの説明有難うございます。
For i = 1 To i = Len(TESTNO) / 2は目的は、070925303133の様な2桁の試験Noがテキストボックスに有った時、文字数を数え2分の1にするとTest項目数が判ります。そこでiを終わらせようと思ってました。
For i = 1 To Len(TESTNO) / 2に修正しました。kは試験規格と条件の列数です、1セルづつコピペしようと思います。
どうも、フォームの3つあるテキストボックスの規格ファイル名、グラフファイル名、TESTNOの内
TESTNOが、実行ボタンを押さないと、入らないので質問の項目がemptyの様です、でもボタンを押すと
瞬時に処理が終わり、希望のコピペはできません。処理をゆっくり見る方法は無いでしょうか?
 
 
とりあえず、Activate、Select や Selection の部分を省略してみました。
Sub main()
  Dim i As Long
  Dim k As Long
  Dim D As Variant

  Dim wbk0 As Workbook
  Dim wbk1 As Workbook

  Dim rng As Range

  Set wbk1 = Workbooks.Open(Filename:=dfilename(1))
  Set wbk0 = Workbooks.Open(Filename:=gfilename(1))
  wbk0.Worksheets("規格値").Range("E10").Offset(0, 0).Range(Cells(1, 1), Cells(15, 7)).ClearContents

  For k = 1 To 7
    For i = 1 To i = Len(TESTNO) / 2 'Test項目数

      D = Val(Mid(TESTNO, (i - 1) * 2 + 1, 2)) 'Test項目の番号
      Set rng = wbk1.Cells.Find(What:="D", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
      If Not rng Is Nothing Then
        rng.Offset(k - 1, 0).Copy
        wbk0.Worksheets("規格値").Range("E10").Offset(k - 1, i - 1).PasteSpecial Paste:=xlFormula
      End If
    Next i
  Next k

  wbk1.Close SaveChanges:=False
  Application.ScreenUpdating = True
  MsgBox ("終了しました")
End Sub

 
 
引用:
Len関数が効いていないのか、1以外変化しない

    For i = 1 To i = Len(TESTNO) / 2 'Test項目数
 
この評価の意味は理解されていますか?
i = Len(TESTNO)
TESTNO が 何にしても、 LENでは文字数を数えていて、その文字数と i を = で比較
比較結果としては、True(-1) または、False(0) なので
 
 i は、1 から、 (-1/2 または 0/2) の範囲で繰り返し
つまり
 
 i は、1 から -1/2
 または
 i は 1 から 0 のくり返し。
 
なので、i は 繰り返していないです。
 
どうすれば良いか?
この条件式をどんな意図で使っているのか判らないので、どんな式にしたら良いのか回答者には判りません。
 
 
引用:
dfilename(1)が入っていないがDataに読み込ませる方法は無いでしょうか?TEXTNOも変数宣言してみました。

 
ここでいうData とは何ですか?
 
 
引用:
D=Val(mid)関数だが、これで動くのでしょうか?

動作するか? 動作はしますよね。
意図する結果が得られているのかは、質問者さんが何をしたいのかが判りませんので
どうすれば 意図する結果が得られるのかは分かりません。

投稿日時: 19/03/26 21:23:04
投稿者: モリチャン

WinArrow さんの引用:
↓のスレと関係すると思いますが
 
https://www.moug.net/faq/viewtopic.php?t=78034
 
こちrは、どのようになったのでしょうか?

 
 
目的は同じです。皆さんにはご心配をかけました。自分のロジックが甘く、本で学んだコードをくっつけて
作ったのが、初めの投稿分です。ロジックを考え直して修正したのが今回のです。まだどうも、フォームと
モジュールの連係が悪い様です、今は、始めグラフファイルの初期化の規格条件領域のクリアはできますが。
コピペができません。

回答
投稿日時: 19/03/26 22:00:43
投稿者: WinArrow
投稿者のウェブサイトに移動

>目的は同じです。皆さんにはご心配をかけました。自分のロジックが甘く、本で学んだコードをくっつけて
>作ったのが、初めの投稿分です。
続きならば、同じスレでつづけた方がよいです。
 
しかし、別スレを立てたならば、最初のスレを閉じてください。
放置するのは、回答者に失礼です。
続きであるということを説明するために
リンクを張るようお願いします。

投稿日時: 19/03/26 22:05:39
投稿者: モリチャン

ご指摘ありがとうございます。
前回分は、閉じさせていただきます。

回答
投稿日時: 19/03/26 22:30:11
投稿者: WinArrow
投稿者のウェブサイトに移動

>find以下が動いていなくて
 
Find の指定方法が正しいのか検証してみましょう。
 
多分、Findメソッドの戻り値が原因だと思います。
 
ステップ実行すれば、すぐに判明します。

回答
投稿日時: 19/03/27 07:16:33
投稿者: simple

処理目的の説明ありがとうございました。

For i = 1 To i = Len(TESTNO) / 2
が間違いで、そのため処理が一度も実行されていない原因について
既にコメントを頂いていますが、
演算の順序にやや正確でないところがあると思われるので、
あらためてコメントしておきます。こうではないでしょうか。
 
ループ処理の最初に、一度だけ
i = Len(TESTNO) / 2 部分の評価がされます。
 
まず数値演算が行われ、Len(TESTNO) / 2が評価されます。
それと i が一致するかどうかにより、TrueまたはFalseが返ります。
 
この時点では i は初期値(Variant型宣言なのでEmpty値)のままですから、
TESTNO.Valueが""で無い限り、i とは不一致になり、Falseが返るはずです。
(もしTESTNO.Valueが""なら、Trueが返る。)
 
Falseは 0 と同等(Trueは-1と同等)ですから、結局

For i = 1 To 0 
もしくは
For i = 1 To -1 
と書いたのと同じですので、
いずれにせよループ内は一度も実行されません。
 
何の気無しに付け加えた
For i = 1 To i = Len(TESTNO) / 2
が思わぬ惨禍をもたらしていたのです。ここはきちんと理解してください。

引用:
処理をゆっくり見る方法は無いでしょうか?
止めたいところにブレークポイントを設けてそこで処理をストップし、
そのあとF8を押せば一行ずつ処理がされます。
これはデバッグの基本ですから、テキストをよく読んで下さい。
こうした方法で、それぞれの行の処理の結果、変数がどう変わっていくかをよく観察して下さい。
たとえば、Cells.Find(What:="D" ...の ように変数を""で囲ってしまうと
変数の意味が失われて、単なる文字列になってしまう、といったことも理解されるでしょう。
 
■なお発言方法について助言します。
全文引用は無駄です。直ぐ上に発言があるのですから全文引用の必要はありません。
また引用文中に直接書き込むと、どれがあなたの発言か分かりません。
とても読みにくいです。
また、あなたのコメントに対応する箇所だけ引用したほうがよいと思います。
そのほうが意図が伝わりやすいと思います。
必要な部分だけをコピーしたあとそこを選択状態にして、
【引用】ボタンをクリックすれば、その部分だけが引用表示にできます。
これを使って下さい。

回答
投稿日時: 19/03/27 13:28:23
投稿者: WinArrow
投稿者のウェブサイトに移動

いくつかの問題個所が見受けられます。
 
コードをいくつかのブロックに分けて質問します。
【第1ブロック】

引用:
Sub dialog_show()
規格転送.規格ファイル = ""
規格転送.送られ側 = ""
規格転送.Show
If Button = "ok" Then Call main
End Sub

もっと見やすく記述すると
Sub dialog_show()
    With 規格転送
        .規格ファイル = ""
        .送られ側 = ""
        .Show
    End With
    If Button = "ok" Then Call main
End Sub
こんな感じになります。
ユーザーフォームを「Unload」か「Hide」しないと
最後のIf文は実行されません。それはそれでどちらでも構いませんが、
変数「Button」はどこに定義さているのでしょうか?
説明では、フォームの処理は完全であるということから、標準モジュールに定義されていると
思いますが、隠さず公開してください。
 
【第2ブロック】
引用:
Workbooks.Open Filename:=gfilename(1)
sinn = ActiveWorkbook.Name
Sheets("規格値").Select
Range("E10").Select
ActiveCell.Offset(0, 0).Range(Cells(1, 1), Cells(15, 7)).Select ’データを貼り付ける領域
Selection.ClearContents

ActivateやSelectをすると、微々たる時間ですが処理速度が落ちます。
↓のように改善できます。
Dim GBook As Workbook
Const 行 As Long = 15, 列 As Long = 7
    Set GBook = Workbooks.Open(Filename:=gfilename(1))
    GBook.Worksheet("規格値").Range("E10").Resize(行, 列).ClearContents

[アドバイス]
変数:GBook、定数:行、列は、このコード以外でも使用するから共通定数として定義しておいた方がよい。
仮に、変更が生じた場合、定数値を変更するだけで対応できます。
 
※質問
変数:gfilename(1))
は、どこに定義されているのでしょうか?
 
【第3ブロック】
[quote]
For k = 1 To 7
For i = 1 To i = Len(TESTNO) / 2 'Test項目数
  ループの中身は別ブロックで質問
Next i
Next k
[/code]
このブロックの問題個所は
simpleサンゴ指摘の
>i = Len(TESTNO) / 2
です。
>試験項目は40くらいあるのですが、それを、テキストボックスで10個くらい指定
とありますから、雰囲気から推測すると、多分2桁の数字x10個くらいを結合した20桁くらいの文字列と思います。
そうすると、変数:iの最大値は、「Len(TESTNO) / 2」でよいと思います。
>くらい
テキストボックスの個数に依存するのだから、
>というあいまいな説明はしない方が分かりやすい
 
しかし、データ格納セル範囲が、15行と規定しているので、10くらいではなく、
最大15個と説明したほうが整合すうるのでは?
書き直すと
    For k = 1 To 列
        For i = 1 To Len(TESTNO) / 2 'Test項目数
            ループの中身は別ブロック
        Next i
    Next k

 
【第4ブロック】
引用:
Workbooks.Open Filename:=dfilename(1)
 Data = ActiveWorkbook.Name
 Windows(sinn).Activate
 Range("E10").Select
 ActiveCell.Offset(k - 1, i - 1).Select
 Windows(Data).Activate
 D = Val(Mid(TESTNO, (i - 1) * 2 + 1, 2)) 'Test項目の番号
Cells.Find(What:="D", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
 xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
 .Activate
 ActiveCell.Offset(k - 1, 0).Copy
 Windows(sinn).Activate
 Selection.PasteSpecial Paste:=xlFormula

このブロックの処理を簡単にいうと
データブックの○○シート(明治されていない)の試験項目データをグラフブックに複写することである。
問題点1
変数:「K」ループの都度データブックを開く処理になっている。
1回だけ開けばよいし、閉じるコードがないから、常にアラーム表示されてプログラムが中断する。
従ってデータブックをループの外に出す方がよい。
 
問題点2
データブック側のシートが説明されていない・・・シートが1つしかなければ問題ないが、
複数存在する場合、明にシートを指定しないと、意図しない結果になる(エラーも含めて)ことが推測される。
 
問題3
> D = Val(Mid(TESTNO, (i - 1) * 2 + 1, 2))
Val関数は、数値化する関数です。例、「02」→「2」となる
Findで検索できないと思います。
 
第4ブロックは、もう少し検討が必要。
 

回答
投稿日時: 19/03/27 14:21:09
投稿者: WinArrow
投稿者のウェブサイトに移動

【第2ブロック】と【第4ブロック】を再編したコードを掲示してみます。
推測部分が多いので、コードを理解して、修正してください。
  

   Set DBook = Workbooks.Open(Filename:=dfilename(1))
    For k = 1 To 列
        For i = 1 To Len(TESTNO) / 2 'Test項目数
            GoSub DaTA_SET
        Next i
    Next k
    DBook.Close False
    Exit Sub
    
DaTA_SET:
Dim 複写元 As Range
    With DBook
        With .Sheets(1)
            D = Mid(TESTNO, (i - 1) * 2 + 1, 2) 'Test項目の番号
            Set 複写元 = .Cells.Find(What:=D, _
                    After:=.Range("A1"), _
                    LookIn:=xlValues, _
                    LookAt:=xlWhole, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
        End With
        GBook.Sheets("規格値").Range("E10").Offset(k - 1, i - 1).Value = 複写元.Value
    End With
    Return

投稿日時: 19/03/27 21:05:11
投稿者: モリチャン

[quote="WinArrow"]いくつかの問題個所が見受けられます。
 
コードをいくつかのブロックに分けて質問します。
【第1ブロック】

引用:
Sub dialog_show()
規格転送.規格ファイル = ""
規格転送.送られ側 = ""
規格転送.Show
If Button = "ok" Then Call main
End Sub

もっと見やすく記述すると
Sub dialog_show()
    With 規格転送
        .規格ファイル = ""
        .送られ側 = ""
        .Show
    End With
    If Button = "ok" Then Call main
End Sub
こんな感じになります。
ユーザーフォームを「Unload」か「Hide」しないと
最後のIf文は実行されません。それはそれでどちらでも構いませんが、
変数「Button」はどこに定義さているのでしょうか?
説明では、フォームの処理は完全であるということから、標準モジュールに定義されていると
思いますが、隠さず公開してください。
 
【第2ブロック】
引用:
Workbooks.Open Filename:=gfilename(1)
sinn = ActiveWorkbook.Name
Sheets("規格値").Select
Range("E10").Select
ActiveCell.Offset(0, 0).Range(Cells(1, 1), Cells(15, 7)).Select ’データを貼り付ける領域
Selection.ClearContents

ActivateやSelectをすると、微々たる時間ですが処理速度が落ちます。
↓のように改善できます。
Dim GBook As Workbook
Const 行 As Long = 15, 列 As Long = 7
    Set GBook = Workbooks.Open(Filename:=gfilename(1))
    GBook.Worksheet("規格値").Range("E10").Resize(行, 列).ClearContents

[アドバイス]
変数:GBook、定数:行、列は、このコード以外でも使用するから共通定数として定義しておいた方がよい。
仮に、変更が生じた場合、定数値を変更するだけで対応できます。
 
※質問
変数:gfilename(1))
は、どこに定義されているのでしょうか?
 
【第3ブロック】
引用:

For k = 1 To 7
For i = 1 To i = Len(TESTNO) / 2 'Test項目数
  ループの中身は別ブロックで質問
Next i
Next k
[/code]
このブロックの問題個所は
simpleサンゴ指摘の
>i = Len(TESTNO) / 2
です。
>試験項目は40くらいあるのですが、それを、テキストボックスで10個くらい指定
とありますから、雰囲気から推測すると、多分2桁の数字x10個くらいを結合した20桁くらいの文字列と思います。
そうすると、変数:iの最大値は、「Len(TESTNO) / 2」でよいと思います。
>くらい
テキストボックスの個数に依存するのだから、
>というあいまいな説明はしない方が分かりやすい
 
しかし、データ格納セル範囲が、15行と規定しているので、10くらいではなく、
最大15個と説明したほうが整合すうるのでは?
書き直すと
    For k = 1 To 列
        For i = 1 To Len(TESTNO) / 2 'Test項目数
            ループの中身は別ブロック
        Next i
    Next k

 
【第4ブロック】
引用:
Workbooks.Open Filename:=dfilename(1)
 Data = ActiveWorkbook.Name
 Windows(sinn).Activate
 Range("E10").Select
 ActiveCell.Offset(k - 1, i - 1).Select
 Windows(Data).Activate
 D = Val(Mid(TESTNO, (i - 1) * 2 + 1, 2)) 'Test項目の番号
Cells.Find(What:="D", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
 xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
 .Activate
 ActiveCell.Offset(k - 1, 0).Copy
 Windows(sinn).Activate
 Selection.PasteSpecial Paste:=xlFormula

このブロックの処理を簡単にいうと
データブックの○○シート(明治されていない)の試験項目データをグラフブックに複写することである。
問題点1
変数:「K」ループの都度データブックを開く処理になっている。
1回だけ開けばよいし、閉じるコードがないから、常にアラーム表示されてプログラムが中断する。
従ってデータブックをループの外に出す方がよい。
 
問題点2
データブック側のシートが説明されていない・・・シートが1つしかなければ問題ないが、
複数存在する場合、明にシートを指定しないと、意図しない結果になる(エラーも含めて)ことが推測される。
 
問題3
> D = Val(Mid(TESTNO, (i - 1) * 2 + 1, 2))
Val関数は、数値化する関数です。例、「02」→「2」となる
Findで検索できないと思います。
 
第4ブロックは、もう少し検討が必要。
 
 
ご指導ありがとうございます
 
すみません。
gfileの宣言は、以下の様に初めにPublicでしかしてありません。
 
Option Explicit
 
Public dfilename
Public gfilename
Public n
Public Button As String
Public TESTNO
Public A
Public B
Public i
Public k
 
 

回答
投稿日時: 19/03/27 21:34:48
投稿者: WinArrow
投稿者のウェブサイトに移動

モリチャン さんの引用:

ご指導ありがとうございます
 
すみません。
gfileの宣言は、以下の様に初めにPublicでしかしてありません。
 
Option Explicit
 
Public dfilename
Public gfilename
Public n
Public Button As String
Public TESTNO
Public A
Public B
Public i
Public k

 
なぜ、変数宣言の時、データ型を指定しないのですか?
 
データ型を指定しないと。バリアント型となります。
そうすると、その変数を参照するたびに、コンピュータ内部で
格納されているデータの型を判定する処理が実行されます。
つまり、「処理時間が掛かる」ということです。
データ型を宣言することにより、微々たる時間かもしれませんが、処理時間を少なくすることができます。
 
>Public dfilename
>Public gfilename
について、プログラムの中では
>gfilename(1)
のように配列形式で参照していますが、どこかで配列化しているのですか?
 
 

投稿日時: 19/03/27 22:01:34
投稿者: モリチャン

色々すみません
今わかったことですfが、以下がフォームのコードです、TEXTNOが入らないのは、コマンドボタン3のプロパティの問題かもしれません。ボタン3がOKの時、TESTNO = 規格転送.Text3.TextのTEXT3でなくて、オブジェクト名のCommandButton3にしなくては、いけないでしょうか?
また、今プロパティを変更しようとしてもできないのですが、どうしたらよいでしょうか?TESTNO = 規格転送.Text3.TextのTEXT3の式で、dfilenameや、Gfilenameの様にデータが入るでしょうか?
 
 
 
 Sub CommandButton1_Click()
Dim msg
    dfilename = Application.GetOpenFilename("全てのファイル(*.xlsx),*.xlsx", , "ファイルを選ぶ", , True)
        msg = dfilename(1)
       規格転送.規格ファイル.Text = msg
 
End Sub
 
 
Private Sub CommandButton2_Click()
    Dim msg
    gfilename = Application.GetOpenFilename("全てのファイル(*.xls),*.xls", , "グラフ規格ファイル", , True)
    msg = gfilename(1)
   規格転送.送られ側.Text = gfilename(1)
End Sub
 
Private Sub CommandButton3_Click()
 Dim TESTNO
 Button = "ok"
    TESTNO = 規格転送.Text3.Text
    Unload 規格転送
End Sub

投稿日時: 19/03/27 22:43:39
投稿者: モリチャン

独りよがりですみません、TEXTNOが、フォームノコマンドボタン3のオブジェクト名指定で改善した時?、
Cells findは、初めの投稿ではどこから始めるか指定しませんでした、1行目は、試験の項目や条件名規格名が入っています。A2からA列のTESTNOの数を探すので、 Range("A2").Selectをつけ、SearchOrder:=xlByColumnsに
方向を、列の上から下にしましたが、これで良いでしょうか?インテンド、windarrowさんのCellsfindのロジックは後で考えさせていただきますが、セルの指定と、その列の検索はこれで良いでしょうか?Dが入るとTESTRNOは、2桁の数字なので、070925303133の様な数字なので、検索できると思うのですが?
 
 
        Workbooks.Open Filename:=dfilename(1)
        Data = ActiveWorkbook.Name
        Windows(sinn).Activate
        Range("E10").Select
        ActiveCell.Offset(k - 1, i - 1).Select
        Windows(Data).Activate
         Range("A2").Select
         D = Val(Mid(TESTNO, (i - 1) * 2 + 1, 2))
        Cells.Find(What:=D, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False) _
        .Activate
        ActiveCell.Offset(k - 1, 0).Copy
        Windows(sinn).Activate
        Selection.PasteSpecial Paste:=xlFormula

投稿日時: 19/03/27 22:49:11
投稿者: モリチャン

WinArrow さんの引用:
モリチャン さんの引用:

ご指導ありがとうございます
 
すみません。
gfileの宣言は、以下の様に初めにPublicでしかしてありません。
 
Option Explicit
 
Public dfilename
Public gfilename
Public n
Public Button As String
Public TESTNO
Public A
Public B
Public i
Public k

 
なぜ、変数宣言の時、データ型を指定しないのですか?
 
データ型を指定しないと。バリアント型となります。
そうすると、その変数を参照するたびに、コンピュータ内部で
格納されているデータの型を判定する処理が実行されます。
つまり、「処理時間が掛かる」ということです。
データ型を宣言することにより、微々たる時間かもしれませんが、処理時間を少なくすることができます。
 
>Public dfilename
>Public gfilename
について、プログラムの中では
>gfilename(1)
のように配列形式で参照していますが、どこかで配列化しているのですか?
 
winarrowさんすみません、始めフォームのコードを作ったとき、 dfilename、gfilename名だけで
作ってあったらファイル名が入らなかったです。配列の1番はじめを参照するとしたとき、ファイル名が
テキストボックスに入りました。  トライアルの結果で、私にはわかりません。
 

回答
投稿日時: 19/03/27 23:37:17
投稿者: WinArrow
投稿者のウェブサイトに移動

モリチャン さんの引用:

TEXTNOが入らないのは、コマンドボタン3のプロパティの問題かもしれません。ボタン3がOKの時、TESTNO = 規格転送.Text3.TextのTEXT3でなくて、オブジェクト名のCommandButton3にしなくては、いけないでしょうか?
また、今プロパティを変更しようとしてもできないのですが、どうしたらよいでしょうか?TESTNO = 規格転送.Text3.TextのTEXT3の式で、dfilenameや、Gfilenameの様にデータが入るでしょうか?

 
変数:TEXTNOの定義のダブり
同じ名前の変数がグローバルとプロシジャ内と両方で定義されていた場合、
プロシジャ内の方が優先的に参照されます。
従って、標準モジュールの方には値は格納されません。
従って、
>コマンドボタン3のプロパティの問題かもしれません
ではないです。
VBAを扱う場合は変数のスコープをきちんと理解するようにしましょう。
 
 
モリチャン さんの引用:

 Sub CommandButton1_Click()
Dim msg
    dfilename = Application.GetOpenFilename("全てのファイル(*.xlsx),*.xlsx", , "ファイルを選ぶ", , True)
        msg = dfilename(1)
       規格転送.規格ファイル.Text = msg
 
End Sub
 
Private Sub CommandButton2_Click()
    Dim msg
    gfilename = Application.GetOpenFilename("全てのファイル(*.xls),*.xls", , "グラフ規格ファイル", , True)
    msg = gfilename(1)
   規格転送.送られ側.Text = gfilename(1)
End Sub

 
GetOpenFilenameメソッドで最後の引数に「True」を指定しているので、
「gfilename」に配列形式で格納されます。
1つしか選択しないのであれば「最後の引数」を省略すればよいです。
そうすれば、わざわざ「(1)」を記述しなくても済みますし、余計なことを考えなくてすみます。
 
モリチャン さんの引用:

Private Sub CommandButton3_Click()
 Dim TESTNO
 Button = "ok"
    TESTNO = 規格転送.Text3.Text
    Unload 規格転送
End Sub

このプロシジャないの「TESTNO」は不要です。
 
全般的に
>規格転送.
のような記述が随所にありますが、
「Me.」と記述することができます。
この方が手間が省けると思いますが…
 
まずは、1つ目
 
 
Activate,selectを止めるように、複数の回答者からアドバイスがあるけれど、無視?
それとも、改善するつもりがない?
 
データブックをループの中で開く
は、無駄、閉じるがないから、常に、同一ブックが開いている・・・のようなアラームあ表示される
ループの外に出しましょう。
 
>TESTNOは、2桁の数字なので、070925303133の様な数字なので、検索できると思うのですが?
確かに、Mid(TESTNO,1,2)では、数字2桁になります。
しかし、Val関数で、数字が1桁、又は、2桁になります。
問題は、検索される側が数値になっているか?です。
それによって、検索されるか?/されないか? が決まります。
因みに、Findメソッドでは、検索できた場合は、セルオブジェクトが返りますが、
検索できなかった場合、Nothingになります(エラーにはなりません)
ですから、検索できなかった場合、別なところでエラーになる可能性があります。
 
※ユーザーフォームで入力した試験項目(番号)は手入力で「値」が保証されているとは限らない。
 
追加レス
 
投稿の仕方について
simpleさんのレスの中に書かれていたことを守ってください。
誰の発言なのかがわかりません。
 
 
 
 
 
 

回答
投稿日時: 19/03/28 09:34:47
投稿者: WinArrow
投稿者のウェブサイトに移動

 
今更ですが・・・・
  
データブック側のデータレイアウトの説明がないので、
よくわかりませんが、
どのような結果を期待しているのですか?
  
 >グラフブック
 といっているから、グラフを作成するためには、数値が複写される必要があると思いますが、
  
FINDで検索出来たセル(試験項目番号)だけが、複写対象になっています。
  
データ側の表のレイアウトと、
意図する結果の表を
説明できますか?
  
   
フォームモジュールのコードを掲示していただきましたが、
テキストボックスが10個くらい
 という説明のあったのに、10個くらいのテキストボックスから
TESTNOにセットする文字列に結合するコードが隠されている。
 
 

投稿日時: 19/03/28 21:04:46
投稿者: モリチャン

[b][quote="WinArrow"]
  
データ側の表のレイアウトと、
意図する結果の表を
説明できますか?
 
オリジナルのコードでは、以下の様な試験規格条件データを、TESTNOの数字、A2から始まるで、
行方向に検索し、その行をコピーペーストする。iが増えると、次の行にコピペされる構想でした。
これはDataシートになっています。これから070925303133の様なtestNoの行を指定で選びます。
 testNo    項目    規格1    規格2    単位    条件    条件2
3    VDSS        500    V    ID= 250uA    VMAX= 999V
6    BVDSX        500    V    ID= 10.00mA    VX= 30.0V
7    VP        2.55    V    VDS= 4V    ID= 1.95mA
10    VP        1.5    V    VDS= 80V    ID= 10μA
9    IDSS    150        nA    VDS= 50V    IMAX= 5μA
25    IDSS    1.5        μA    VDS= 500V    IMAX= 1.00mA
28    IDSS    5        μA    VDS= 27V    IMAX= 1.00mA
30    IDSX    10        V    VDS= 450V    VX= 30
31    HRDON    76        mR    ID= 18.5A    VG= 10.0V
32    HBTON    12        V    VCE= 8.77V    IC= 55.5A
33    DIVID        22    V        
41    HVFECS    1.04        mV    IC= 37A    
45    ISGS    100        nA    VSG= 35V    IMAX= 1μA
47    ISGS    100        nA    VSG= 35V    IMAX= 1μA
 
これをグラフファイルの規格値シートのE10(testNo7)から始まる行に貼り付けます。今は手入力、
テスト    テセック        試験規格        試験条件    
No.    試験項目    MAX    MIN    単位    条件1    条件2
7    VP        2.55    V    VDS= 4V    ID= 1.95mA
9    IDSS    150        nA    VDS= 50V    IMAX= 5μA
25    IDSS    1.5        μA    VDS= 500V    IMAX= 1.00mA
30    IDSX    10        V    VDS= 450V    VX= 30
31    HRDON    76        mR    ID= 18.5A    VG= 10.0V
33    HVFECS    1.04        mV    IC= 37A    
                        
フォームモジュールのコードを掲示していただきましたが、
テキストボックスが10個くらい
 という説明のあったのに、10個くらいのテキストボックスから
TESTNOにセットする文字列に結合するコードが隠されている。
 
フォームのコマンドボタン3のコード
TESTNO =規格転送.Text3.Text が規格転送フォームのテキストボックスTEXT3の文字列が
TESTNOになると思います。
 
[/u]

投稿日時: 19/03/28 21:11:30
投稿者: モリチャン

[b][quote="WinArrow"]
  
Findメソッドの方向が列方向検索でしたが、A1から下に行が下る、SearchOrder:=xlByColumnsに変更します。

回答
投稿日時: 19/03/28 22:55:42
投稿者: WinArrow
投稿者のウェブサイトに移動

モリチャン さんの引用:

Findメソッドの方向が列方向検索でしたが、A1から下に行が下る、SearchOrder:=xlByColumnsに変更します。

 
説明とコードが一致していません。
 
「A1から下に行が下る」
だったら、最初のコードのように
SearchOrder:=xlByRows
です。
 
データ表の説明ありがとうございました。
 
やはり、元コードでは、グラフボックの表を作成することができないと思います。
 
データ側の表の項目名とグラフ側の表の項目名が違っていますが、
データ側の表の当該行の7つのセルを複写すればよいのですよね?
 
そうすると
ループが外側と内側の二重になっていますが、
外側のループは不要ではないかと思います。
 

投稿日時: 19/03/28 23:09:32
投稿者: モリチャン

規格データと理想のグラフデータは、最後の規格急いで作ってコピー間違えて内容違います。
test番号の指定の規格と条件を貼り付ければよいのです。
 
 
なかなかうまく動いてくれません。
質問ですが、DaTA_SET:
Dim Data As Range
    With Dbook
        With .Sheets(1)
            D = Mid(TESTNO, (i - 1) * 2 + 1, 2) 'Test項目の番号
            Set Data = .Cells.Find(What:=D, _
                    After:=.Range("A1"), _
                    LookIn:=xlValues, _
                    LookAt:=xlWhole, _
                    SearchOrder:=xlByColumns, _
                    SearchDirection:=xlNext, _
の中の、Sheets(1)は何を指定すれば良いのでしょうか?Dfileのdata sheetでしょうか?
そうだとすると、 With .data sheets(1)でしょうか?
 
また書いて頂いたコードでペーストできるのでしょうか?

投稿日時: 19/03/29 00:08:36
投稿者: モリチャン

testNo	項目	規格1	規格2	単位	条件	条件2
3	VDSS		500	V	ID= 250uA	VMAX= 999V
6	BVDSX		500	V	ID= 10.00mA	VX= 30.0V
7	VP		2.55	V	VDS= 4V	ID= 1.95mA
10	VP		1.5	V	VDS= 80V	ID= 10μA
9	IDSS	150		nA	VDS= 50V	IMAX= 5μA
25	IDSS	1.5		μA	VDS= 500V	IMAX= 1.00mA
28	IDSS	5		μA	VDS= 27V	IMAX= 1.00mA
30	IDSX	10		V	VDS= 450V	VX= 30
31	HRDON	76		mR	ID= 18.5A	VG= 10.0V
32	HBTON	12		V	VCE= 8.77V	IC= 55.5A
33	DIVID		22	V		
41	HVFECS	1.04		mV	IC= 37A	
45	ISGS	100		nA	VSG= 35V	IMAX= 1μA
47	ISGS	100		nA	VSG= 35V	IMAX= 1μA


上がA1からある規格条件データ表です。dataシートにある。

回答
投稿日時: 19/03/29 07:04:08
投稿者: simple

横から失礼。
> Sheets(1)は何を指定すれば良いのでしょうか?Dfileのdata sheetでしょうか?
それは仕様を知っているあなたが提示すべき話。
> そうだとすると、 With .data sheets(1)でしょうか?
いまやシートの指定方法の質問になっている。
左からみて1番目という意味を理解されないなら、
Worksheets("シート名")という基本的な書き方を使うべき。
 
Findを使った検索に関して、規格1の列とマッチしてしまうケースも
ありえそうだから、A列だけに対象範囲を限定してはどうか。
Cells.Findとシート全体を検索するのでは効率も悪いはずだ。
A列対象なら
Columns("A").Find・・・・となるだろう。
ただし、開始位置はActiveCellではなく、A列の特定セルを指定する。
 
また、コピーも行単位で纏めてコピーすれば、繰り返しは不要。
今のコードでは、マッチしたセルから列方向のデータを取ってきているから
修正が必要ではないか。
 
最初の質問はループが動作しない、それを解決したい、という
ピンポイントの質問と受け止めた。
しかし、質問がなし崩し的に全体に拡がってきている。
ポイントを絞った質問じゃなくて、丸まるの作業依頼と実質同じことになっている。
 
最終目的はグラフを書くようだが、
グラフになるようなデータはまだ一向に提示されていない。
まだまだ先は長そうだ。
 
そうであるなら、最初からきちんと内容を説明すべきだと思う。
冒頭の説明では他人にはちっとも理解できない。
・関係するシートのレイアウト
・現在使っているユーザーフォームの各コントロールの内容
・使用するデータの例(規格表に加えてデータ表も)
・アウトプットの例(グラフ作成のためのデータの提示)
以上がまずは必須です。
 
以下はできればで結構ですが、あると良いかも知れない。
・現時点でできているコードの全体の提示
・また、変数の型をきちんと定義すべき。Variant型ではなく。
  またPublicは極力避けた方がよい。
 
なお、今までの発言は、全文引用の多用、部分毎に発言者がだれか判別不明の投稿の連続で、
これではとても他の回答者が読む気にはならない。
(そのことを指摘しても、余計な指摘だ、くらいに思っているのだろう)
 
一区切りついたところでこちらは一旦閉じて、
あらためて全体を説明し直して再出発したほうが
「急がば回れ」で早いかも知れない。

回答
投稿日時: 19/03/29 08:23:10
投稿者: WinArrow
投稿者のウェブサイトに移動

最初の質問からすると、
だいぶ範囲が広がってしまっていますね・・・・
 
なにか、「やぶをつついたら、蛇が出てきた」ようですね?
でも、やぶをつついたおかげで、
変数:TESTNO に定義方法に問題があったことがわかった。
デバッグさえきちんとできていれば、
質問の仕方もちがっていたかも・・・
どこかに
>フォームのコードは、完全の様
と書いてありましたが、過信はダメ。そこに落とし穴があります。
 
 
質問者さんは、どうも、行き当たりばったり的な感じがします。
1.論理設計ができていない。
2.コードの理解が中途半端
3.覚えた単語を適当にちりばめている
4.論理セ系ができていない状態で、全体のコードを作成してしまう。
  →非常に効率が悪い
 
今のまま続行すると
システム設計のところまで踏み込んでしまいます。
提案したコードも理解しないまま、コピペして使ってしまうような気がします。
 
一回、コードを全部作り変えるつもりで
現在の手作業を、細かく分析し(箇条書きに)
全体を整理してから、
それを基に再設計をお勧めします。
 

回答
投稿日時: 19/03/29 13:17:22
投稿者: WinArrow
投稿者のウェブサイトに移動

データブックのシートレイアウトなどの掲示があったので
投稿日時: 19/03/27 14:21:09
を修正したコードを掲示します。
 
ユーザーフォーム内の処理で隠されている?(もしかしたら、まだ考えていないかも?)
があるけれど・・・・
TESTNOに「試験項目番号」が格納されているという前提で
 

   Set DBook = Workbooks.Open(Filename:=dfilename)
    For i = 1 To Len(TESTNO) / 2 'Test項目数
        GoSub DaTA_SET
    Next i
    DBook.Close False
    Exit Sub
    
DaTA_SET:
Dim 複写元 As Range
    With DBook
        With .Sheets("データ")
            D = Val(Mid(TESTNO, (i - 1) * 2 + 1, 2)) 'Test項目の番号
            Set 複写元 = .Columns("A").Find( _
                    What:=D, _
                    LookIn:=xlValues, _
                    LookAt:=xlWhole, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
        End With
    End With
    If Not 複写元 Is Nothing Then
        With GBook.Sheets("規格値")
            .Range("E10").Offset(i - 1, 0).Resize(1, 7).Value = 複写元.Resize(1, 7).Value
        End With
    Else
        Msgbox "試験項目番号検索できず:「" & Format(D, "00") & "」"
    End If
    Return

 

投稿日時: 19/03/29 23:18:52
投稿者: モリチャン

Winarrow様、simple様 その他各位
親切丁寧なご指導ありがとうございます。3月期末までに短時間化の改善でマクロを作れと言う命令で、2月末からプログラム初心者で、本を読み始め、色々試しのマクロ作っては、最後にこちらのフォーラムに投稿させていただきました。期末今日、まだ実用化しないので適用しないと言う判断になったので、一回閉じさせていただきます。お忙しい時間に、私の拙いプログラムに助言いただきありがとうございました。一流の助言はすごいと思いました。iの使い方、Len関数のご説明、配列のtrueによる違い。withコードも本で読んでいましたが、使えるまで理解していませんでした。まだ助言いただいたマクロではコピーができません。フォームの部分のミスを今日1件発見し、モジュールの変数は全部動いていますが、システムをもう一回考えてみようと思います。ここ数日が、一番成長したなと思います。このマクロは非常に重要なマクロでまた、アドバイス頂くことが有るかもしれませんが、その時も暖かいご支援よろしくおねがいします。
 

回答
投稿日時: 19/03/30 23:21:29
投稿者: mattuwan44

パニクってて、
ロジックがぐちゃぐちゃなのか、
ロジックをちゃんとVBA語で表現できてないのか解らないけど。。。。
こんな感じかな?
   

Option Explicit

Sub main()
    Dim wbkResult As Workbook   '検索結果を書き込むブック
    Dim wbkData As Workbook     '検索するデータがあるブック
    Dim rngOld As Range         '検索する表のセル範囲
    Dim rngNew As Range         '検索結果を貼りつけるセル範囲
    Dim ixFrom As Long          '探した行の相対位置
    Dim ixTo As Long            '書き込む行の相対位置
    Dim sKey As Long            '検索するTestNo
    Dim i As Long               'ループカウンタ

    Set wbkResult = Workbooks.Open(Filename:=gfilename(1))
    Set rngNew = wbkResult.Worksheets("規格値").Range("E10").Resize(15, 7)
    rngNew.ClearContents

    Set wbkData = Workbooks.Open(Filename:=dfilename(1))
    Set rngOld = wbkData.Worksheets(1).UsedRange

    For i = 1 To Len(TESTNO) Step 2
        sKey = Val(Mid(TESTNO, i, 2))
        ixform = 0
        On Error Resume Next
        ixFrom = WorksheetFunction.Match(sKey, rngOld.Columns(1), 0)
        On Error GoTo 0
        If ixFrom > 0 Then
            ixTo = ixTo + 1
            rngOld.Rows(ixFrom).Copy rngNew.Rows(ixTo)
        End If
    Next
    
    wbkData.Close False
End Sub

  
   
参考URL>>
http://www.ken3.org/vba/excel-help.html
   
あと、オブジェクトという言葉の意味の理解と、オブジェクト変数を使えるようになるのと、
セル範囲を示す語彙を増やしましょう^^
セルは必ずどれかのシートに存在していて、必ずどれかのブックに存在しています。
なので、セルをちゃんと指定できたなら、そのセルはどのブックのどのシートに所属しているのか、
情報を持ってます。
逆に言うと、どのブックのどのシートのセルなのかをちゃんと指し示せなければ、
エクセル君は、
意図したセル以外を操作してしまったり、「意味解らない」とエラーを返してきたりします。
   
参考URL>>
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_cell.html

投稿日時: 19/04/07 11:59:39
投稿者: モリチャン

EXCEL VBAフォーラム各位 mattuwan44様
 
お礼が遅れてすみませんでした。
目的の、試験条件と規格をコピーして貼り付けるマクロ動いて、実用化できそうです。
全て、EXCEL VBAフォーラムの皆様特に mattuwan44様のマクロです。
自分でまだコードを完全に理解していないので、表の項目が変わったときに変更できませんが、
理解するつもりです。
有難うございます。本当にありがとうございます。