Question

我希望将以下两个子程序合并为一个子程序。我希望每行都这样做，我收到一个错误。任何关于出了什么问题的建议都将不胜感激。

Sub URL_Classification()
'Keyboard Shortcut: Ctrl Shift + X
Dim i As Long, an As Long, bn As Long
Dim a, b, c As Range
Application.ScreenUpdating = False
a = Array("Facebook", "Linkedin", "Twitter", "Youtube", "Vimeo")
b = Array("RSS", "Feed", "Xml", "rdf", "atom", "syndication.axd")
Columns(5).ClearContents
For Each c In Range("d1", Range("d" & Rows.Count).End(xlUp))
  If c <> "" Then
    an = 0: bn = 0
    For i = LBound(a) To UBound(a)
      If InStr(c, a(i)) Then
        an = i
        Exit For
      End If
    Next i
    For i = LBound(b) To UBound(b)
      If InStr(c, b(i)) Then
        bn = 1
        Exit For
      End If
    Next i
    If an = 0 And bn = 0 Then
      c.Offset(, 1) = "General"
    ElseIf an <> 0 And bn = 0 Then
      c.Offset(, 1) = a(an)
    ElseIf an = 0 And bn <> 0 Then
      c.Offset(, 1) = b(bn)
    ElseIf an <> 0 And bn <> 0 Then
      c.Offset(, 1) = a(an)
    End If
  End If
  Sub RemoveDuplicates()
Cells.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), Header:=xlNo
End Sub
Next c
Application.ScreenUpdating = True
End Sub

此外，这不一定很重要，但有没有任何方法可以删除在执行'RemoveDuplicates'时总是出现的空行？

Sub RemoveDuplicates()
    Sheets("Work").Select
    Range("D1300").Activate
    ActiveSheet.Range("$A$1:$F$1300").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6 _
    ), Header:=xlNo
    End Sub

Answer 1

你不能在另一个sub中定义一个sub。也许你想要call一个来自另一个的子，这样你就可以在你不需要的子内部进行call或复制粘贴代码。

Answer 2

你的sub有两个End Sub语句。在VBA中，如果没有前面的End Sub，则不能有Sub。如果要在到达结尾之前离开子例程，请使用Exit Sub。

合并两个子程序

2 个答案: