Question

我有一个宏代码，但它只在特定的列上运行，并且只在500的范围内运行。我希望它能动态选择标题列＆＃39;产品＆＃39;存在。如果可能，我们可以将“限制”列中的所有数据的限制增加到500，产品＆＃39;

Sub Pats()

myCheck = MsgBox("Do you have Patent Numbers in Column - B ?", vbYesNo)
    If myCheck = vbNo Then Exit Sub

endrw = Range("B500").End(xlUp).Row

Application.ScreenUpdating = False

For i = 2 To endrw
PatNum = Cells(i, 2).Value
If Left(Cells(i, 2), 2) = "US" Then
link = "http://www.google.com/patents/" & PatNum
Cells(i, 2).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http://www.google.com/patents/" & PatNum, ScreenTip:="Click to View", TextToDisplay:=PatNum
With Selection.Font
        .Name = "Arial"
        .Size = 10
End With

ElseIf Left(Cells(i, 2), 2) = "EP" Then
link = "http://www.google.com/patents/" & PatNum
Cells(i, 2).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http://www.google.com/patents/" & PatNum, ScreenTip:="Click to View", TextToDisplay:=PatNum
With Selection.Font
        .Name = "Arial"
        .Size = 10
End With

End If
Next i
End Sub

Answer 1

我首先将链接构建部分提取到一个单独的子例程中......

Sub AddLink(c As Range)
  Dim link As String
  Dim patNum As String
  Dim test As String
    patNum = c.Value
    test = UCase(Left(patNum, 2))
    If test = "US" Or test = "EP" Then
        link = "http://www.google.com/patents/" & patNum
    Else
        link = "http://www.www.hyperlink.com/" & patNum
    End If
    c.Hyperlinks.Add Anchor:=c, Address:=link, ScreenTip:="Click to View", TextToDisplay:=patNum
    With c.Font
        .Name = "Arial"
        .Size = 10
    End With
End Sub

然后我会添加一个函数来查找列...

Function FindColumn(searchFor As String) As Integer
  Dim i As Integer
    'Search row 1 for searchFor
    FindColumn = 0
    For i = 1 To ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column
        If ActiveSheet.Cells(1, i).Value = searchFor Then
            FindColumn = i
            Exit For
        End If
    Next i
End Function

最后我会把它们放在一起......

Sub Pats()
  Dim col As Integer
  Dim i As Integer
    col = FindColumn("PRODUCTS")
    If col = 0 Then Exit Sub
    For i = 2 To ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
        AddLink ActiveSheet.Cells(i, col)
    Next i
End Sub

我承认我必须使用SO来提醒自己如何在工作表上获取最后一个使用过的单元格（请参阅Find Last cell from Range VBA）。

Answer 2

下面的代码将找到哪个列包含标题PRODUCTS，然后找到该列中的最后一行并将其存储在变量lrProdCol中。

Sub FindProductLR()
    Dim col As Range
    Dim endrw As Long

    Set col = Rows(1).Find("PRODUCTS")
    If Not col Is Nothing Then
        endrw = Cells(Rows.count, col.Column).End(xlUp).Row
    Else
        MsgBox "The 'PRODUCTS' Column was not found in row 1"
    End If
End Sub

所以替换下面的代码

myCheck = MsgBox("Do you have Patent Numbers in Column - B ?", vbYesNo)
    If myCheck = vbNo Then Exit Sub

endrw = Range("B500").End(xlUp).Row

上面的行。希望有所帮助

选择具有特定标题的列范围

2 个答案: