こんにちは、趣味でエクセルVBAを勉強し始めたのですが、
タイトルの方法でうまくいかずに困っています。
教えていただけますと嬉しいです。
<やりたいこと>
シート1のセルA1に入力したキーとなる文字列で、シート2~シート5を検索して、
ヒットしたセルの4列横の文字列を、
シート1のセルA3から下に書き込んでいきたいです。
<現在>
色々と試行錯誤して、コードを書いたのですが、無限ループになってしまいます。
エクセルVBAの本の通りに書いたつもりです。
何度見てもコードは間違えていないように見えるのですが、
必ずエラーになってしまいます。
自分では思いこんでいて気づかない間違いなどがあるのかと思い、
掲示板に書かせてもらいました。
お分かりになる方がいらっしゃったら、教えてください。
よろしくお願いいたします。
エラーになる箇所は、下のコードのうち、◆の箇所です。
<コード>
Sub checksheet()
Dim i, j As Integer
Dim sheetname As String
Dim key As String
Dim myrange As Range
Dim myrange2 As Range
Dim myaddress As String
Dim strrange As Range
key = Worksheets(1).Cells(1, 1).Value
sheetname = ActiveSheet.Name
j = 3
For i = 2 To Worksheets.Count
sheetname = Worksheets(i).Name
Worksheets(sheetname).Select
Set myrange = Range("A1").CurrentRegion
myrange.Offset(1).Resize(myrange.Rows.Count - 1).Select
Set srtrange = Range("A2:A10")
Set myrange2 = srtrange.Find(what:=key, LookIn:=xlValues)
If Not myrange2 Is Nothing Then
Do
Worksheets(1).Cells(j, 1).Value = myrange2.Offset(, 4).Value
◆Set myrange2 = srtrange.FindNext(after:=myrange2)
j = j + 1
If j = 100 Then
’無限ループ対策
Exit Sub
End If
Loop Until myrange2.Address = myaddress
Else
End If
Next i
End Sub
No.1ベストアンサー
- 回答日時:
ループ終了条件の
>Loop Until myrange2.Address = myaddress
にある変数:myaddress って変数の宣言をしたあとで何も値を代入してないから無限ループになるでしょうね。
If Not myrange2 Is Nothing Then
myaddress = myrange2.Address ' ここで myaddress に最初に見つかったアドレスを代入しておく。
Do
◆についてはExcelなしのOSなので検証は出来ませんけど。
少なくともエラーでって事なら『どんなエラー内容が表示されるのか』は情報として必要かも。
なるほどー!
そういわれてみれば、myaddressに何も入れてません!
入れてみたら、無限ループにならなくなりました。
助かりました。
あとは、エラー内容ですね。
エラー内容をどこで見ればいいのかわからず、不勉強で申し訳ないです。
デバッグの仕方をもうちょっと勉強してみます。
本当にありがとうございました!
No.3
- 回答日時:
基本的なことですが、
Dim key As String
Dim myrange As Range
Dim myrange2 As Range
Dim myaddress As String
Dim strrange As Range
わざわざ、変数を宣言しているのですから、ここに工夫をして、大文字・小文字を組み合わせましょう。
そうすれば、変数名のミスに気が付きます。最後には、
Option Explicit
を入れれば、確実に分かります。
そして、エラーの原因は、strRange でしょうけれども、
◆Set myrange2 = srtrange.FindNext(after:=myrange2)
srt となって、str ではありません。それら(複数)を直したらエラーは消えます。
それと、
If j = 100 Then
'無限ループ対策
Exit Sub
End If
Find メソッドで無限ループ対策というのは、ほとんどないことですが、万が一に必要な時は、
DoEvents を用いて、Escape ブレークを入れられるようにします。
>Set srtrange = Range("A2:A10")
>Set myrange2 = srtrange.Find(what:=key, LookIn:=xlValues)
8個のセルで、Findメソッドは大掛かりすぎますね。For Each ~ in [領域]でも済むと思います。
ところで、話が飛びますが、
>趣味でエクセルVBAを勉強し始めたのですが、
この言葉がなかったら、書き加えることはなかったのですが、一応、こういうものがあります、とだけお教えします。
今回のコードは、定番がヘルプでは丸々出ていて、それを貼り付けるだけで済んだかもしれません。私は、未だにこの定番の組み込みコードを覚えていません。
ダウンロード版ヘルプより(中身は英語のみ) GitHubに出ているというのは変ですが。
//XLVBACon.chm//
https://github.com/OfficeDev/VBA-content/blob/05 …
With Worksheets(1).Range("a1:a500")
Set c = .Find(2, lookin:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Value = 5
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
ありがとうございます!
さっそく大文字小文字を使い分けてみたところ、スペル間違いがはっきり分かるようになりました。
自動で同じスペルの文字列に大文字小文字が変換されるなんて思ってなかったので、感動しました。
DoEventsについても教えていただいてありがとうございます。
調べたのですが、これを使うと、「Esc」キーで無限ループから抜け出せるということですね?
間違えいたらすみません。
それから、ヘルプやGitHubにもそのまんまの情報があるとのことで、こちらも助かりました。
知らなかったので、有難いです。
本当に様々な情報をありがとうございました。
No.2
- 回答日時:
こんばんは!
他の方がお考えになったコードに手を付けるのは好みでないので
最初から勝手にやってみました。
Sheet2以降のすべてのシートのA2~A10セルの範囲を検索すればよいのですね。
一例です。
Sub Sample1()
Dim k As Long, cnt As Long
Dim myRng As Range, FoundCell As Range, FirstCell As Range
Dim wS As Worksheet
With Worksheets(1)
cnt = 2
For k = 2 To Worksheets.Count
Set wS = Worksheets(k)
Set myRng = wS.Range("A1:A10") '//★//
Set FoundCell = myRng.Find(what:=.Range("A1"), LookIn:=xlValues, lookat:=xlWhole)
If Not FoundCell Is Nothing Then
Set FirstCell = FoundCell
GoTo 処理
Do
Set FoundCell = myRng.FindNext(after:=FoundCell)
If FoundCell.Address = FirstCell.Address Then Exit Do
処理:
cnt = cnt + 1
.Cells(cnt, "A") = FoundCell.Offset(, 4)
Loop
End If
Next k
End With
End Sub
※ コード内の「★」の部分のように範囲は各シートのA1~A10セルとしています。
A2セルからの範囲指定の場合、仮にA2セルと他のセルに複数該当データがヒットした場合
A2セルがそのシートの最後に表示されてしまいます。
(なぜそうなるのかは当方も判りません)
1行目は項目行でSheet1のA1セルと同じデータはない!という考えです。
表示順が変わってもよいのであれば
範囲をA2~A10セルに変更してみてください。m(_ _)m
こちらはFor Next 構文を使ったコードなのですね。
勉強したてなので、こんな風にも書けるというのはとても参考になります。
情報ありがとうございました!
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
このQ&Aを見た人はこんなQ&Aも見ています
-
あるあるbotに投稿したけど採用されなかったあるある募集
あるあるbotに投稿したけど採用されなかったあるあるをこちらに投稿してください
-
フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
あなたが普段思っている「これまだ誰も言ってなかったけど共感されるだろうな」というあるあるを教えてください
-
映画のエンドロール観る派?観ない派?
映画が終わった後、すぐに席を立って帰る方もちらほら見かけます。皆さんはエンドロールの最後まで観ていきますか?
-
海外旅行から帰ってきたら、まず何を食べる?
帰国して1番食べたくなるもの、食べたくなるだろうなと思うもの、皆さんはありますか?
-
天使と悪魔選手権
悪魔がこんなささやきをしていたら、天使のあなたはなんと言って止めますか?
-
findは動くがfindnextがマクロで動きません。記述は同じはずなのですが…
Visual Basic(VBA)
-
フォームのテキストボックスの値をコピーしたい
Excel(エクセル)
-
エクセルのラベルの値(文字列)を垂直方向で中央揃えにするには?
Excel(エクセル)
-
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
VBAマクロ実行時エラーの修正に...
-
エクセルVBA 配列からセルに「...
-
特定の色のついたセルを削除
-
Excel UserForm の表示位置
-
EXCEL VBA 文中の書式ごと複写...
-
VBA にて、条件付き書式で背景...
-
VBA:日付を配列に入れ別セルに...
-
エクセルVBAで、セル内のテキス...
-
VBAについて
-
CellEnterイベント仕様について
-
EXCELのフォーム上でリアルタイ...
-
【VBA】【ユーザーフォーム_Lis...
-
Excel VBAでCheckboxの名前を変...
-
ユーザフォームを使ってのデー...
-
DataGridViewのフォーカス遷移...
-
エクセルのカーソルを非表示に...
-
IEで正しく見えるのにNNだと表...
-
Excelで空白セル直前のセルデー...
-
【Excel VBA】マクロで書き込ん...
-
オーバーフローを回避する方法?
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
VBAマクロ実行時エラーの修正に...
-
エクセルVBA 配列からセルに「...
-
【Excel VBA】一番右端セルまで...
-
Excel UserForm の表示位置
-
特定の色のついたセルを削除
-
Excelで空白セル直前のセルデー...
-
【VBA】【ユーザーフォーム_Lis...
-
VBA:日付を配列に入れ別セルに...
-
VBA にて、条件付き書式で背景...
-
C# DataGridViewで複数選択した...
-
入力規則のリスト選択
-
Excel VBA IF文がうまく動作し...
-
【VBA】写真の貼り付けコードが...
-
Excel 範囲指定スクショについ...
-
EXCEL VBA 文中の書式ごと複写...
-
Excel VBAでCheckboxの名前を変...
-
EXCEL 2010 VBAでピボットで複...
-
飛び地セルの空白判定
-
エクセルのカーソルを非表示に...
-
CellEnterイベント仕様について
おすすめ情報
皆さん、ありがとうございます!
有益な情報なども書いてくださって、感謝します。
帰宅後、また動きを確認してから個々へのご返答とさせていただきます(^-^)