Question

我有两个用于同一Excel电子表格的程序，想将它们组合到一个程序中，但是我似乎无法使它正常工作。如果有人可以提供帮助，我们将不胜感激。我试过的是从第二个程序中取出Sub do_it（），从第一个程序中取出End Sub。我将所有内容都包括在这里，以便您可以看到两个完整的程序。

Sub do_it()


    n = [E15]
    Set reg = CreateObject("VBScript.RegExp")
    reg.Pattern = "^[0-9]*\-[0-9]*$"
    reg.Global = True
    For Each cell In      Range("A15:A30,C15:C30,E15:E30,G15:G30,I15:I30")
    strVAL = cell.Offset(0, 1).Value
    If cell.Value = n And reg.test(strVAL) Then
    Range(“E15”).Value = StrVal
    MsgBox "Found a postivive result in " &   cell.Address
    End If

    Next

End Sub

-

Sub do_it()

    Dim n, sht As Worksheet, cell As Range, num,          tmp, rngDest As Range

    Set sht = ActiveSheet

    n = sht.Range("E15")

    For Each cell In    sht.Range("A15:A30,C15:C30,E15:E30,G15:G30,I15:I3 0").Cells

    tmp = cell.Offset(0, 1).Value

    If cell.Value = n And tmp Like "*#-#*" Then

    'get the first number
    num = CLng(Trim(Split(tmp, "-")(0)))
    Debug.Print "Found a positive result in " &    cell.Address

'find the next empty cell in the appropriate row
    Set rngDest = sht.Cells(num,    sht.Columns.Count).End(xlToLeft).Offset(0, 1)
'make sure not to add before col K
     If rngDest.Column < 12 Then Set rngDest =   sht.Cells(num, 12)

    cell.Offset(0, 1).Copy rngDest
    Exit For

    End If
    Next
End Sub

Answer 1

我不确定您到底想做什么，但是要执行多项操作，最好将其分解为较小的子例程或函数，例如，您应该这样做。要同时运行两者，您需要调用sub main。请记住，您不能有重复的子名称或函数名称：

    Sub main()

        Call FirstCode
        Call SecondCode

    End Sub


    Sub FirstCode()
        n = [E15]
        Set reg = CreateObject("VBScript.RegExp")
        reg.Pattern = "^[0-9]*\-[0-9]*$"
        reg.Global = True
        For Each cell In Range("A15:A30,C15:C30,E15:E30,G15:G30,I15:I30")
        StrVal = cell.Offset(0, 1).Value
        If cell.Value = n And reg.test(StrVal) Then
        Range(“E15”).Value = StrVal
        MsgBox "Found a postivive result in " & cell.Address
        End If

        Next
    End Sub

    Sub SecondCode()
         Dim n, sht As Worksheet, cell As Range, num, tmp, rngDest As Range

        Set sht = ActiveSheet

        n = sht.Range("E15")

        For Each cell In sht.Range("A15:A30,C15:C30,E15:E30,G15:G30,I15:I3 0").Cells

        tmp = cell.Offset(0, 1).Value

        If cell.Value = n And tmp Like "*#-#*" Then

        'get the first number
        num = CLng(Trim(Split(tmp, "-")(0)))
        Debug.Print "Found a positive result in " & cell.Address

        'find the next empty cell in the appropriate row
        Set rngDest = sht.Cells(num, sht.Columns.Count).End(xlToLeft).Offset(0, 1)
         'make sure not to add before col K
         If rngDest.Column < 12 Then Set rngDest = sht.Cells(num, 12)

        cell.Offset(0, 1).Copy rngDest
        Exit For

        End If
        Next
    End Sub

试图将两个VBA程序合并在一起

1 个答案: