如何为宏中的串联功能定义单元格范围

时间:2018-11-28 03:13:13

标签: excel vba concatenation

我是在发送邮件之前连接一些行的任务。 因此,我为串联和电子邮件创建了一个均正常工作的按钮。但是问题来了,我被问到一旦我单击按钮而不是单击按钮n选择范围,是否有可能显示结果(合并结果)

如果是这样,我应该怎么做?

*因为我需要以单封邮件发送给多个收件人,而我的代码没有问题

当前在我的Excel中

Sheet1是要在工作表2中显示级联单元格的结果

示例

Sheet1 A1(显示清单) emailaddress1,emailaddress2,emailaddress3,emailaddres4

Sheet1 B1(抄送列表) emailaddress1,emailaddress2,emailaddress3,emailaddres4

Sheet1 C1(密件抄送列表) emailaddress1,emailaddress2,emailaddress3,emailaddres4

Sheet2 A1(显示列表) *显示为行

电子邮件地址1 emailaddress2 emailaddress3 emailaddress4

CC n BCC列表也一样

这是我使用的代码

    Sub Concatenate()
    'Creates a basic CONCATENATE formula with no options
    Call Concatenate_Formula(True, False)
end sub
    Sub Concatenate_Formula(bConcat As Boolean, bOptions As Boolean)
Dim rSelected As Range
Dim c As Range
Dim sArgs As String
Dim bCol As Boolean
Dim bRow As Boolean
Dim sArgSep As String
Dim sSeparator As String
Dim rOutput As Range
Dim vbAnswer As VbMsgBoxResult
Dim lTrim As Long
Dim sTitle As String
Dim sActive As String
Dim sSheetRef As String

    'Set variables
    Set rOutput = ActiveCell
    sActive = ActiveSheet.Name
    bCol = False
    bRow = False
    sSeparator = ""
    sTitle = IIf(bConcat, "CONCATENATE", "Ampersand")

    'Prompt user to select cells for formula
    On Error Resume Next
    Set rSelected = Application.InputBox(Prompt:= _
                    "Select cells to create formula", _
                    Title:=sTitle & " Creator", Type:=8)
    On Error GoTo 0

    'Only run if cells were selected and cancel button was not pressed
    If Not rSelected Is Nothing Then

        'Set argument separator for concatenate or ampersand formula
        sArgSep = IIf(bConcat, ",", "&")

        'Prompt user for absolute ref and separator options
        If bOptions Then

            vbAnswer = MsgBox("Columns Absolute? $A1", vbYesNo)
            bCol = IIf(vbAnswer = vbYes, True, False)

            vbAnswer = MsgBox("Rows Absolute? A$1", vbYesNo)
            bRow = IIf(vbAnswer = vbYes, True, False)

            sSeparator = Application.InputBox(Prompt:= _
                        "Type separator, leave blank if none.", _
                        Title:=sTitle & " separator", Type:=2)

        End If

        If rSelected.Parent.Name <> sActive Then
            sSheetRef = "'" & rSelected.Parent.Name & "'!"
        Else
            sSheetRef = ""
        End If

        'Create string of cell references
        For Each c In rSelected.Cells
            sArgs = sArgs & sSheetRef & c.Address(bRow, bCol) & sArgSep
            If sSeparator <> "" Then
                sArgs = sArgs & Chr(34) & sSeparator & Chr(34) & sArgSep
            End If
        Next

        'Trim extra argument separator and separator characters
        lTrim = IIf(sSeparator <> "", 4 + Len(sSeparator), 1)
        sArgs = Left(sArgs, Len(sArgs) - lTrim)

        'Create formula
        'Warning - you cannot undo this input
        'If undo is needed you could copy the formula string
        'to the clipboard, then paste into the activecell using Ctrl+V
        If bConcat Then
            rOutput.Formula = "=CONCATENATE(" & sArgs & ")"
        Else
            rOutput.Formula = "=" & sArgs
        End If

    End If

End Sub

0 个答案:

没有答案