Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


7597 / 13644 ツリー ←次へ | 前へ→

【38011】ユーザーフォームが開かない。リストボックスが反映されない。 初心者です。 06/5/25(木) 8:25 質問[未読]
【38016】Re:ユーザーフォームが開かない。リストボックスが反映さ... Jaka 06/5/25(木) 10:04 回答[未読]
【38067】Re:ユーザーフォームが開かない。リストボックスが反映さ... 初心者です。 06/5/25(木) 21:25 お礼[未読]

【38011】ユーザーフォームが開かない。リストボックスが反映さ...
質問  初心者です。  - 06/5/25(木) 8:25 -

引用なし
パスワード
   下記のとおりのコードを書いたのですが2箇所でエラーが発生してしまいます。
ご指導のほどよろしくお願いいたします。
Private Sub ken_Click()
Dim adrs As Variant
Dim addr As Variant
Dim theadd As Variant
Dim i As Integer
Dim d As Integer
i = 0
Worksheets("結果").Select
Range("A3:A60000").Select
Selection.ClearContents
theadd = adr.Value
Worksheets(1).Range("a1:c35000").Font.Color = RGB(0, 0, 0)
With Worksheets(1).Range("a1:c35000")
Set adrs = .Find(theadd)
If Not adrs Is Nothing Then
addr = adrs.address
Do
i = i + 1
Worksheets(1).Select
adrs.Select
Selection.Font.Color = RGB(225, 0, 0)
Selection.Copy
Worksheets("結果").Select
Range("A1").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
Worksheets(1).Select
Set adrs = .FindNext(adrs)

Loop While adrs.Value = adrs And adrs.address <> addr
Worksheets("結果").Cells(2, 1).Value = i
d = Worksheets("結果").Cells(2, 1).Value
d = d + 2
'下記のとおりリストボックスにワークシート『結果』を反映させたいのですがエラーになります。
ListBox1.RowSource = Worksheets("結果").Range(Cells(3, 1), Cells(d, 1)).address
Else
'下記のようにユーザーフォームを開こうとしてもエラーになります。
備考.Show
MsgBox "該当なし"
End If
End With
End Sub

よろしくお願いいたします。

【38016】Re:ユーザーフォームが開かない。リストボックスが反映...
回答  Jaka  - 06/5/25(木) 10:04 -

引用なし
パスワード
   >'下記のとおりリストボックスにワークシート『結果』を反映させたいのですがエラーになります。
>ListBox1.RowSource = Worksheets("結果").Range(Cells(3, 1), Cells(d, 1)).address

Cellsの方にもシートを指定してください。
Rangeだけ指定しても、Cellsの方はどこ見ていいのか解りませんよ。
Worksheets("結果").Cells(・・・・。

【38067】Re:ユーザーフォームが開かない。リストボックスが反映...
お礼  初心者です。  - 06/5/25(木) 21:25 -

引用なし
パスワード
   Jakaさん
早速アドバイス通りやってみると、できました!!
本当にありがとうございます!!できて感動です(涙)

7597 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free