Excel-VBA解析范围之间的值

Question

Is there a way to parse values between a range into a single cell?(preferably delimited?)

For example:

Column A, Cell 1: ID01

Column B, Cell1: ID06

I would like to Column C, Cell 1 output:

ID01;ID02;ID03;ID04;ID05;ID06

I have a similar script that parses the values but adds them per new cell.I'd like to get everything on one cell.

Sub CreateRange()

Dim counter As Integer
Dim cursor As Integer

counter = 2
cursor = 2

While Not IsEmpty(ThisWorkbook.Sheets("Macro2").Range("C" & cursor).Value)
    ThisWorkbook.Sheets("Macro2").Range("A" & counter).Value = ThisWorkbook.Sheets("Macro2").Range("C" & cursor).Value

    While ThisWorkbook.Sheets("Macro2").Range("A" & counter).Value < ThisWorkbook.Sheets("Macro2").Range("D" & cursor).Value
        ThisWorkbook.Sheets("Macro2").Range("A" & counter).Select
        Selection.AutoFill Destination:=ThisWorkbook.Sheets("Macro2").Range("A" & counter & ":" & "A" & counter + 1), Type:=xlFillValues

        counter = counter + 1
        ThisWorkbook.Sheets("Macro2").Range("A" & counter).Select
    Wend
    cursor = cursor + 1
    counter = counter + 1
Wend

ThisWorkbook.Sheets("Macro2").Range("A1").Select

End Sub

Thanks in advance!

Answer 1

Try this out:

Sub tryit()
  Dim that As String

  that = ""
  For i = Replace(Range("a1").Value, "ID", "") + 0 To Replace(Range("b1").Value, "ID", "") + 0
    that = that + ";" + "ID" + Format(i, "0#")
  Next

  that = Right(that, Len(that) - 1)

  Range("c1").Value = that
End Sub

Per the question this Takes A1, B1 and iterates over the difference between ID#

Answer 2

To accomplish this with Excel VBA, use Chip Pearson's String Concatenation function:

http://www.cpearson.com/excel/stringconcatenation.aspx

Copy/paste the below code into a new Module file in your worksheet. Call the function as follows:

=StringConcat(";",A1:B5)

You will get the desired result.

Function StringConcat(Sep As String, ParamArray Args()) As Variant
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' StringConcat
' By Chip Pearson, chip@cpearson.com, www.cpearson.com
'                  www.cpearson.com/Excel/stringconcatenation.aspx
' This function concatenates all the elements in the Args array,
' delimited by the Sep character, into a single string. This function
' can be used in an array formula. There is a VBA imposed limit that
' a string in a passed in array (e.g.,  calling this function from
' an array formula in a worksheet cell) must be less than 256 characters.
' See the comments at STRING TOO LONG HANDLING for details.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim S As String
Dim N As Long
Dim M As Long
Dim R As Range
Dim NumDims As Long
Dim LB As Long
Dim IsArrayAlloc As Boolean

'''''''''''''''''''''''''''''''''''''''''''
' If no parameters were passed in, return
' vbNullString.
'''''''''''''''''''''''''''''''''''''''''''
If UBound(Args) - LBound(Args) + 1 = 0 Then
    StringConcat = vbNullString
    Exit Function
End If

For N = LBound(Args) To UBound(Args)
    ''''''''''''''''''''''''''''''''''''''''''''''''
    ' Loop through the Args
    ''''''''''''''''''''''''''''''''''''''''''''''''
    If IsObject(Args(N)) = True Then
        '''''''''''''''''''''''''''''''''''''
        ' OBJECT
        ' If we have an object, ensure it
        ' it a Range. The Range object
        ' is the only type of object we'll
        ' work with. Anything else causes
        ' a #VALUE error.
        ''''''''''''''''''''''''''''''''''''
        If TypeOf Args(N) Is Excel.Range Then
            '''''''''''''''''''''''''''''''''''''''''
            ' If it is a Range, loop through the
            ' cells and create append the elements
            ' to the string S.
            '''''''''''''''''''''''''''''''''''''''''
            For Each R In Args(N).Cells
                If Len(R.Text) > 0 Then
                    S = S & R.Text & Sep
                End If
            Next R
        Else
            '''''''''''''''''''''''''''''''''
            ' Unsupported object type. Return
            ' a #VALUE error.
            '''''''''''''''''''''''''''''''''
            StringConcat = CVErr(xlErrValue)
            Exit Function
        End If

    ElseIf IsArray(Args(N)) = True Then
        '''''''''''''''''''''''''''''''''''''
        ' ARRAY
        ' If Args(N) is an array, ensure it
        ' is an allocated array.
        '''''''''''''''''''''''''''''''''''''
        IsArrayAlloc = (Not IsError(LBound(Args(N))) And _
            (LBound(Args(N)) <= UBound(Args(N))))
        If IsArrayAlloc = True Then
            ''''''''''''''''''''''''''''''''''''
            ' The array is allocated. Determine
            ' the number of dimensions of the
            ' array.
            '''''''''''''''''''''''''''''''''''''
            NumDims = 1
            On Error Resume Next
            Err.Clear
            NumDims = 1
            Do Until Err.Number <> 0
                LB = LBound(Args(N), NumDims)
                If Err.Number = 0 Then
                    NumDims = NumDims + 1
                Else
                    NumDims = NumDims - 1
                End If
            Loop
            On Error GoTo 0
            Err.Clear
            ''''''''''''''''''''''''''''''''''
            ' The array must have either
            ' one or two dimensions. Greater
            ' that two caues a #VALUE error.
            ''''''''''''''''''''''''''''''''''
            If NumDims > 2 Then
                StringConcat = CVErr(xlErrValue)
                Exit Function
            End If
            If NumDims = 1 Then
                For M = LBound(Args(N)) To UBound(Args(N))
                    If Args(N)(M) <> vbNullString Then
                        S = S & Args(N)(M) & Sep
                    End If
                Next M

            Else
                ''''''''''''''''''''''''''''''''''''''''''''''''
                ' STRING TOO LONG HANDLING
                ' Here, the error handler must be set to either
                '   On Error GoTo ContinueLoop
                '   or
                '   On Error GoTo ErrH
                ' If you use ErrH, then any error, including
                ' a string too long error, will cause the function
                ' to return #VALUE and quit. If you use ContinueLoop,
                ' the problematic value is ignored and not included
                ' in the result, and the result is the concatenation
                ' of all non-error values in the input. This code is
                ' used in the case that an input string is longer than
                ' 255 characters.
                ''''''''''''''''''''''''''''''''''''''''''''''''
                On Error GoTo ContinueLoop
                'On Error GoTo ErrH
                Err.Clear
                For M = LBound(Args(N), 1) To UBound(Args(N), 1)
                    If Args(N)(M, 1) <> vbNullString Then
                        S = S & Args(N)(M, 1) & Sep
                    End If
                Next M
                Err.Clear
                M = LBound(Args(N), 2)
                If Err.Number = 0 Then
                    For M = LBound(Args(N), 2) To UBound(Args(N), 2)
                        If Args(N)(M, 2) <> vbNullString Then
                            S = S & Args(N)(M, 2) & Sep
                        End If
                    Next M
                End If
                On Error GoTo ErrH:
            End If
        Else
            If Args(N) <> vbNullString Then
                S = S & Args(N) & Sep
            End If
        End If
        Else
        On Error Resume Next
        If Args(N) <> vbNullString Then
            S = S & Args(N) & Sep
        End If
        On Error GoTo 0
    End If
ContinueLoop:
Next N

'''''''''''''''''''''''''''''
' Remove the trailing Sep
'''''''''''''''''''''''''''''
If Len(Sep) > 0 Then
    If Len(S) > 0 Then
        S = Left(S, Len(S) - Len(Sep))
    End If
End If

StringConcat = S
'''''''''''''''''''''''''''''
' Success. Get out.
'''''''''''''''''''''''''''''
Exit Function
ErrH:
'''''''''''''''''''''''''''''
' Error. Return #VALUE
'''''''''''''''''''''''''''''
StringConcat = CVErr(xlErrValue)
End Function