Excel (VBA)

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

 
(Windows 10 Pro : Excel 2016)
VBA do loop
投稿日時: 24/02/09 15:30:25
投稿者: み-1108

よろしくお願いいたします。
やりたいことは
シート名 印刷シート_着工時
 
B4 セルに 番号を入力します。
シート名:着工時のA列の該当の番号を探し
B8、C8 セルに 値を代入を該当すべてを繰り返す
 
例)
B4 1 を 入力すると
B8 (1) C8 説明書
B9 (2) C9 別紙
 
というようにしたいと思っております。
データは別シートにあります。
 
シート名 着工時
    A列    B列    C列
4    1    書類1    
5        (1)    説明書
6        (2)    別紙
7    2    書類2    
8        (1)    お知らせ
9        (2)    規制
10        (3)    対策
11        (4)    施設
 
 
 
 
Sub test()
    Dim myRange As Range
    Dim myObj As Range
    Dim keyWord As String
    Dim sht As Worksheet
    Dim i As Integer
    sht = Worksheets("着工時")
     
     
    Set myRange = Worksheets("着工時").Range("A4:A50")
    keyWord = Worksheets("印刷シート_着工時").Range("B4")
    Set myObj = myRange.Find(keyWord, LookAt:=xlWhole)
 
    If myObj Is Nothing Then
        MsgBox "'" & keyWord & "'はありませんでした"
    Else
    
    i = 1
    r = 8
     
    sht.myObj.Select
     
    Do Until sht.myObj.Offset(i, 0) = ""
     
    Worksheets("印刷シート_着工時").Cells(r, 2) = sht.myObj.Offset(i, 1)
    Worksheets("印刷シート_着工時").Cells(r, 3) = sht.myObj.Offset(i, 2)
     
    i = i + 1
    r = r + 1
     
    Loop
     
    MsgBox "'" & keyWord & "'は" & myObj.Row & "行目にあります"
    End If
     
End Sub
 
エラーが出てよくわかりません。
どなたか教えていただけないでしょうか。
よろしくお願いいたします。
 
 
 
 
[/u]

回答
投稿日時: 24/02/09 16:29:26
投稿者: WinArrow

引用:
エラーが出てよくわかりません。

  
これだけの説明では、誰も答えられないです。
 
少なくとも
ラーとなった場所
エラー番号と、エラーメッセージ
は書いてください。
  
処理の解析には、ステップ実行をお勧めします。
変数の値を確認できます。
処理の流れを確認できます。
 

投稿日時: 24/02/09 16:53:10
投稿者: み-1108

説明不足で申し訳ありません。
 
sht.myObj.select
 
で、
コンパイルエラー
メソッドまたはデータメンバーが見つかりません。
というエラーが表示されます。
 
よろしくお願いいたします。

回答
投稿日時: 24/02/09 17:11:51
投稿者: WinArrow

情報ありがとうございます。
 
エラーの原因1

引用:

    sht = Worksheets("着工時")

は、
    Set sht = Worksheets("着工時")
変数:sht がオブジェクト型なので、Set 命令が必要です。
 
エラーの原因2
引用:

    sht.myObj.Select

少なくとも、shtは不要です。
しかし、選択'Sekect)が必要でしょうか?
 
エラー予定
引用:

    Do Until sht.myObj.Offset(i, 0) = ""
      
    Worksheets("印刷シート_着工時").Cells(r, 2) = sht.myObj.Offset(i, 1)
    Worksheets("印刷シート_着工時").Cells(r, 3) = sht.myObj.Offset(i, 2)

 
shtの修飾は不要
 
テストしたわけではないので、キチンと確認してください。

回答
投稿日時: 24/02/09 17:32:37
投稿者: WinArrow

追加レス
インデントをつけた方可読性が向上します。
 
 
セルの値を操作する場合は、Valueプロパティを付けましょう。

引用:

Worksheets("印刷シート_着工時").Cells(r, 2) =


Worksheets("印刷シート_着工時").Cells(r, 2).Value =

回答
投稿日時: 24/02/09 20:18:45
投稿者: simple

 (1)
    sht = Worksheets("着工時")
 のほうが先にエラーになると思います。
 実際は Set sht = Worksheets("着工時") だったのでしょうか?
 投稿にあたっては、できるだけVBEの画面にあるものをそのままコピーされたほうが
 いいですよ。手入力には、入力ミスという"noise"が入る危険性があるので。
  
 (2)
 sht.myObj がエラーになるのは、(仮に正当にshtがWorksheetオブジェクトだったとして)
 (a)Worksheetオブジェクトは、myObjというプロパティもメソッドも持っていないからです。
 (b)また、実は、myObjというRangeオブジェクトは、それがあるシートを内部で持っています(*)から、
    そもそもWorksheetを指定する必要がありません。
    (*)RangeオブジェクトのParentプロパティは親オブジェクトであるWorsheetオブジェクトを
        保持しています ←混乱するようならスキップして結構です。
  ★上の説明が難しければ、
  「なんらかのオブジェクトに "."(ドット)を付けて続けられるのは、予め定められた
    プロパティやメソッドに限定され、勝手に作ることはできない」と覚えておいてください。
  
 (3)あと気になるのは、

    Do Until myObj.Offset(i, 0) = "" 
  です。
    これの意味は、下に一つずつ見て行って、"" になるまでという意味です。
    ということは、その次の行は""でしょうから、すぐに繰り返しを終了します。
 
    Do Until myObj.Offset(i, 0) <> "" とするか
    Do while myObj.Offset(i, 0) = "" です。
  
 「着工時」シートの最後のデータの次のA列セルに、何らかのデータ
 (たとえばENDとか)がないと、シートの最後の行まで見に行ってしまうので注意が必要。
   
 皆さんのご指摘に加え、
 このあたりを検討して、再度トライされたらいかがですか?

回答
投稿日時: 24/02/09 22:09:41
投稿者: WinArrow

現在のエラーの対応ができると、次の問題が待っています。
こちらは、多分エラーにはなrにと思います。
 
simpleさん、ご指摘の
> Do Until myobj.offset(i,0 = ""
の件

引用:

シート名 着工時
    A列 B列 C列
4  1 書類1
5   (1) 説明書
6   (2) 別紙
7  2 書類2
8   (1) お知らせ
9   (2) 規制
10  (3) 対策
11  (4) 施設

のレイアウト
で、考えてみると・・・・・
 
myOBJ.Value = 1 の時
myObj.Offset(1, 0) は、 "" ですから、1件も処理せずにループが終了してしまいます。
  
A列の空白セルに上セルの値と同じ値がセットできれば、比較的簡単に対応できると思います。
再検討してみてください。
 

回答
投稿日時: 24/02/10 10:20:58
投稿者: WinArrow

引用:

    Do Until sht.myObj.Offset(i, 0) = ""
      
    Worksheets("印刷シート_着工時").Cells(r, 2) = sht.myObj.Offset(i, 1)
    Worksheets("印刷シート_着工時").Cells(r, 3) = sht.myObj.Offset(i, 2)
      
    i = i + 1
    r = r + 1
      
    Loop

の代案の参考コードを紹介します。
このコードは、解答ではありません。動きを確認するためのものです。
 
Dim LastRow As Long
    With sht
        Set myOBJ = .Columns("A").Find(what:=keyWord, lookat:=xlWhole)
        LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        i = 1
        Do Until (myOBJ.Offset(i, 0).Value <> "" Or myOBJ.Offset(i, 0).Row > LastRow)
            Debug.Print myOBJ.Offset(i, 1).Address
            i = i + 1
        Loop
    End With

投稿日時: 24/02/17 14:48:17
投稿者: み-1108

WinArrow様、simple様 ありがとうございました。
時間がかかりましたが、いただきましたヒントで無事に動くようになりました。
 
ありがとうございました。