私のコードは、その最初のセルに設定されています。他のセルはありません

Question

タイトルはすべてです。私はこの短いコードをウェブサイトのURLを試してみるために書いた。しかし、何らかの理由で私がたくさん使ってきたこの種のテンプレートは、コードに直接呼び出された唯一のセルであるB2へのロイヤルトリートメントを与えるだけで、今度は私にはうまくいかなかった。私はデバッグをうまくやって、うまくいきません。エラーがないと、問題の内容を識別することが難しくなります。あなたの誰かがここで何が起こっているかを見ることができるなら、私に知らせてください。

Sub Website() 
Application.ScreenUpdating = False 

Range("B2").Select 

Dim TitleString As Range, cel As Range 
Set TitleString = ActiveCell 
Do Until IsEmpty(ActiveCell) 
    For Each cel In TitleString 
    If InStr(1, cel.Value, "https://") > 0 Then ' 
     Selection.Replace What:="https://", Replacement:="", LookAt:=xlPart, _ 
     SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
     ReplaceFormat:=False 
    End If 

    If InStr(1, cel.Value, "http://") > 0 Then 
     Selection.Replace What:="http://", Replacement:="", LookAt:=xlPart, _ 
     SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
     ReplaceFormat:=False 
    End If 

    If InStr(1, cel.Value, "/") > 0 Then 
     Selection.Replace What:="/*", Replacement:="", LookAt:=xlPart, _ 
     SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
     ReplaceFormat:=False 
    End If 

    If InStr(1, cel.Value, "www.") > 0 Then 
     Exit For 

    ElseIf InStr(1, cel.Value, "www.") = 0 Then 
     ActiveCell.Value = "www." & ActiveCell.Value 

    Exit For 
    End If 

    Next cel 
ActiveCell.Offset(1, 0).Select 
Loop 


Application.ScreenUpdating = True 
End Sub 

Answer 1

いつでも1つ選択すると、vbaの速度が低下します。

これは、選択およびループを回避します。

Sub Website() 
Dim rng As Range 
Dim ws As Worksheet 

Application.ScreenUpdating = False 
Set ws = ActiveSheet 
Set rng = ws.Range(ws.Cells(2, 2), ws.Cells(ws.Rows.Count, 2).End(xlUp)) 
rng.Replace "https://", "" 
rng.Replace "http://", "" 
rng.Replace "/*", "" 
rng.Replace "www.", "" 
rng.Value = Evaluate("INDEX(""www.""&" & rng.Address & ",)") 

Application.ScreenUpdating = True 
End Sub 

前：

後：

Answer 2

それが失敗しているように全体をループに一つだけのセルをありますので、あなたがループの外TitleString範囲を設定するため、これが見えます。 doループを完全に削除することで、これを大幅に簡素化できます。代わりに、最初に範囲としてループするセルを宣言します。

Sub Website() 
    Application.ScreenUpdating = False 

    Range("B2").Select 
    Dim rng As Range 
    Dim cel As Range 

    Set rng = Range(Selection, Selection.End(xlDown)) 

    For Each cel In rng 

     ' IF STATEMENTS 

    Next 

    Application.Screenupdating = True 
End Sub