用细胞中的URL格式化力

Question

我试图将用户输入URL进入合并单元格的位置(＆quot" f22：i22＆quot"(它会自动格式化它为URL/超链接。因此，如果有人进入google.com，它将使其成为https://www.google.com/并验证它。

我有。(我几乎很肯定这是错误的(

Sub formaturl () 
    if ishyperlink(value) then values (x,y) = format(value, "https:// .com")
End Sub 

我已经看到了代码，您可以将超链接添加到下拉列表中。这不是我想要的，因为用户将添加他们的公司URL。

编辑：这是我能够工作的最终代码。我还修改了"超链接"。细胞样式是16个字体，没有下划线以使其更容易阅读。

Sub handlethingone(target As Range)
    Dim ws As Worksheet
    Dim xCell As Range
    Dim prefixAddress As String
    Dim suffixAddress As String
    Set xCell = ActiveSheet.Range("F22")
    Set ws = ActiveSheet
    prefixAddress = "www."
    suffixAddress = ".com"
    With ws
       If .Range("F22").Value <> vbNullString Then
            If Not Left(.Range("F22").Value, 4) = prefixAddress Then
                xCell.Parent.Hyperlinks.Add Anchor:=xCell, Address:="", SubAddress:= _
                prefixAddress & xCell, TextToDisplay:=prefixAddress & xCell
            End If
            If Not Right(.Range("F22").Value, 4) = suffixAddress Then
                xCell.Parent.Hyperlinks.Add Anchor:=xCell, Address:="", SubAddress:= _
                xCell & suffixAddress, TextToDisplay:=xCell & suffixAddress
            End If
        End If
    End With
  With xCell.Font
        .Name = ("Arial")
        .Size = 16
        .Color = RGB(0, 0, 0)
        .Underline = xlUnderlineStyleNone
    End With
    With xCell.Font
        .Name = ("Arial")
        .Size = 16
        .Color = RGB(0, 0, 0)
        .Underline = xlUnderlineStyleNone
    End With

End Sub

Answer 1

您可以尝试如下所示：

Option Explicit
Sub HyperlinkFormatter()
    Dim ws As Worksheet
    Dim xCell As Range
    Dim prefixAddress As String
    Dim suffixAddress As String
    
    Set xCell = ActiveSheet.Range("F22")
    Set ws = ActiveSheet
    prefixAddress = "www."
    suffixAddress = ".com"
    
    With ws
       If .Range("F22").value <> vbNullString Then
            If Not Left(.Range("F22").value, 4) = prefixAddress Then
                xCell.Parent.Hyperlinks.Add Anchor:=xCell, address:="", SubAddress:= _
                prefixAddress & xCell, TextToDisplay:=prefixAddress & xCell
            End If
            If Not Right(.Range("F22").value, 4) = suffixAddress Then
                xCell.Parent.Hyperlinks.Add Anchor:=xCell, address:="", SubAddress:= _
                xCell & suffixAddress, TextToDisplay:=xCell & suffixAddress
            End If
        End If
    End With
    
    With xCell.Font
        .ColorIndex = xlAutomatic
        .Underline = xlUnderlineStyleNone
    End With
    With xCell.Font
        .Underline = xlUnderlineStyleSingle
        .Color = -4155132
    End With
End Sub