| |
▼VBA初心者 さん：
こんばんは。
>いつもスイマセンが、Do Loopを使用して行が空白になるまで検索するマクロをくんでみました。もし見付らなかったら、
>エラーとして回避して、次の文字を検索しようとしたのですが、1回目は良いのですが、2回目になるとデバックエラーが出てしまいます。
>エラーって1回しか回避できないしょうか？
>もし、良い回避のさせ方があれば教えて下さい。
>
>
>Sub 検索()
>
>Dim i As Integer
>
>i = 2
>Sheets("検索結果").Select
>
>Do Until Cells(i, 1) = ""
>
>ラベル名 = Cells(i, 1) '検索する文字
>
>Sheets("検索").Select
>
>On Error GoTo ERR
>Cells.Find(What:=ラベル名, After:=ActiveCell, LookIn:=xlFormulas, _
> LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
> MatchCase:=False).Activate
>
>'ラベル名の右にアドレスが記入されている。
>ActiveCell.Offset(0, 1).Activate
>ActiveCell.Copy
>
>Sheets("検索結果").Select
>Cells(i, 2).Select
>Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
> False, Transpose:=False
>GoTo 次へ
>
>ERR:
>Sheets("検索結果").Select
>Cells(i, 2) = ""
>次へ:
>
>i = i + 1 '行数カウンタ
>Loop
>
>End Sub
以下のコードで試してみて下さい。
'=======================================================
Sub 検索()
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim f_rng As Range
Dim i As Integer
Set sht1 = Worksheets("検索結果")
Set sht2 = Worksheets("検索")
i = 2
Do Until sht1.Cells(i, 1).Value = ""
ラベル名 = sht1.Cells(i, 1).Value '検索する文字
Set f_rng = sht2.Cells.Find(What:=ラベル名, _
After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not f_rng Is Nothing Then
sht1.Cells(i, 2).Value = f_rng.Offset(0, 1).Value
Else '見つからなかった場合
sht1.Cells(i, 2).Value = ""
End If
i = i + 1 '行数カウンタ
Loop
Set sht1 = Nothing
Set sht2 = Nothing
Set f_rng = Nothing
End Sub
・かなり事がActivateなしでも可能です
・理由が無い限り、Cells()の後ろには、
プロパティ（この場合はValue）を付けた方が良いと思いますよ。
・GOTO文は、否定はしませんが、見せていただいたような使用方法には
私は、反対です。コードがもっと複雑になった場合、メンテナンスが非常に
困難になりやすいです（アセンブラを見ているのでは？なんて錯覚する程、
わかりにくくなってしまう場合もありますよ）。
気がついた点を記述しました。
投稿したコードで確認してみて下さい。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
