@frswataru (本石 渉)

Are you sure you want to delete the question?

If your question is resolved, you may close it.

Leaving a resolved question undeleted may help others!

We hope you find it useful!

Excel VBA Loop処理

解決したいこと

標記のコードのハイパーリンク化の処理をB列の最終行まで繰り返したいです

該当するソースコード

Sub HL()
'__________________________変数の宣言'__________________________
Dim ws1 As Worksheet
Dim i As Long
Set ws1 = Worksheets("ED_Sheet")
'__________________________ハイパーリンク化'__________________________

ws1.Activate
        Range("B2").Hyperlinks.Add Anchor:=Range("B2"), Address:=Range("B2").Value


End Sub
0 likes

3Answer

横槍を失礼します。
短縮してみました。

Sub HL()
'__________________________変数の宣言'__________________________
Dim ws1 As Worksheet
Dim i As Long
Dim LastRow As Long   '---B列の最終行を取得するために増やしました
Set ws1 = Worksheets("ED_Sheet")
'__________________________ハイパーリンク化'__________________________

    With ws1
        .Activate

        LastRow = .Cells(Rows.Count, 2).End(xlUp).Row   '---B列の最終行を取得
        i = 2   '---B2からはじめたいので、最初に「2」を指定

            Do Until i = LastRow + 1
                .Cells(i, 2).Hyperlinks.Add Anchor:=.Cells(i, 2), Address:=.Cells(i, 2).Value
                i = i + 1
            Loop
    End With
End Sub
2Like

こんな感じでどうでしょうか?


Sub HL()
'__________________________変数の宣言'__________________________
Dim ws1 As Worksheet
Dim i As Long
Dim LastRow As Long   '---B列の最終行を取得するために増やしました
Set ws1 = Worksheets("ED_Sheet")
'__________________________ハイパーリンク化'__________________________

ws1.Activate

    LastRow = ws1.Cells(Rows.Count, 2).End(xlUp).Row   '---B列の最終行を取得
    i = 2   '---B2からはじめたいので、最初に「2」を指定

        Do Until i = LastRow + 1
            Range(ws1.Cells(i, 2)).Hyperlinks.Add Anchor:=Range(ws1.Cells(i, 2)), Address:=Range(ws1.Cells(i, 2)).Value
            i = i + 1
        Loop

End Sub


Whileを使うなら、Do Until i = LastRow + 1Do While i < LastRow + 1 に。

1Like

こんなのもありかと。

    With ws1
        Dim c As Range
        For Each c In Intersect(.Range("B2").Resize(.Rows.Count - 1), .Cells.SpecialCells(xlCellTypeConstants))
            .Hyperlinks.Add Anchor:=c, Address:=c.Value
        Next
    End With

1Like

Your answer might help someone💌