将列中的一系列excel单元合并为一个由新行分隔的单个单元格

时间:2014-08-13 23:47:43

标签: excel vba excel-vba vbscript split

我需要excel的帮助。

我有一个包含数百个单元格的列,我需要将它组合成一个单元格。

单元格中的值已经居中。此外,某些单元格具有多个值,这些值使用( ALT + ENTER )堆叠在一起。

我需要选择一系列这些细胞并将它们组合在一起并将它们叠加在一个细胞中。

如果我还可以消除值之间的额外“新线”以及重复的值,这将是一个额外的奖励。

这是一张它看起来像什么以及我的目标是什么的图片。我一直在努力学习vbscript和宏,但这是在一个截止日期。我很感激帮助。

1 个答案:

答案 0 :(得分:1)

下面介绍如何将列中的所有数字组合到VBA Excel中的单个单元格中,这就是我假设您正在使用的编码语言。

我使用了两个程序: 1)columnCombine() Sub 2)自定义Split()功能由Microsoft的Wade Tai提供

  

使用分割功能链接到韦德的文章:http://msdn.microsoft.com/en-us/library/aa155763%28office.10%29.aspx

columnCombine() Sub:

Sub columnCombine()
    'variables needed:
    Dim col As Integer
    Dim startRow As Integer
    Dim endRow As Integer
    Dim firstCell As Range
    Dim lastCell As Range
    Dim i As Integer
    Dim s As Variant
    Dim destinationCell As Range
    Dim strg As Variant
    Dim strgTemp() As String

    'enter first and last cells of column of interest in the "A1/A2/A3..." format below:'
    Set firstCell = Range("A1") 'this can be what you want
    Set lastCell = Range("A3")  'this can be what you want

    'enter destination cell in same format as above
    Set destinationCell = Range("B1") 'this can be what you want

    'get column of interest
    col = firstCell.Column

    'get start row and end row
    startRow = firstCell.Row
    endRow = lastCell.Row

    'set temp string
    strg = ""

    For i = startRow To endRow
        strgTemp = Split(Worksheets("Sheet1").Cells(i, col).Value)
        For Each s In strgTemp
            If strg = "" Then
                strg = s
            Else
                strg = strg & vbNewLine & s
            End If
        Next s
        Erase strgTemp
    Next i
    'add column to string
    destinationCell.Value = strg

End Sub

Split()功能:

Public Function Split(ByVal InputText As String, _
         Optional ByVal Delimiter As String) As Variant

' This function splits the sentence in InputText into
' words and returns a string array of the words. Each
' element of the array contains one word.

    ' This constant contains punctuation and characters
    ' that should be filtered from the input string.
    Const CHARS = "!?,;:""'()[]{}"
    Dim strReplacedText As String
    Dim intIndex As Integer

    ' Replace tab characters with space characters.
    strReplacedText = Trim(Replace(InputText, _
         vbTab, " "))

    ' Filter all specified characters from the string.
    For intIndex = 1 To Len(CHARS)
        strReplacedText = Trim(Replace(strReplacedText, _
            Mid(CHARS, intIndex, 1), " "))
    Next intIndex

    ' Loop until all consecutive space characters are
    ' replaced by a single space character.
    Do While InStr(strReplacedText, "  ")
        strReplacedText = Replace(strReplacedText, _
            "  ", " ")
    Loop

    ' Split the sentence into an array of words and return
    ' the array. If a delimiter is specified, use it.
    'MsgBox "String:" & strReplacedText
    If Len(Delimiter) = 0 Then
        Split = VBA.Split(strReplacedText)
    Else
        Split = VBA.Split(strReplacedText, Delimiter)
    End If
End Function

<强> *更新:

如果您希望在多个不同的列上使用它以将所有内容移动到一个单元格,请以递归方式或以某种重复方式使用此代码,例如编写一个脚本,该脚本使用columnCombine将您引用的列部分组合到一列中的不同单元格中。然后再次运行程序(或根据需要多次运行),以便将数据放入一个单元格中。

如果您想更改迭代列的顺序,例如您想要从A4迭代到A1而不是A1到A4,只需将For i = startRow To endRow更改为For i = endRow To startRow即可。 请注意,这不会更改单个单元格内的数据组织顺序,只会更改整列。换句话说,{["hello","Hello"],["One"],["Two", "Three"]}将成为{["Two","Three"],["One"],["hello","Hello"]}

要更改单元格中的顺序,您需要更改For Each中的columnCombine()语句或 手动更改strg的顺序。两者都不难做到。

这是我要做的解决方案:

除当前变量外还添加此内容:

Dim strg2 As Variant 
strg2 = ""

更改此代码:

For i = startRow To endRow
    strgTemp = Split(Worksheets("Sheet1").Cells(i, col).Value)
    For Each s In strgTemp
        If strg = "" Then
            strg = s
        Else
            strg = strg & vbNewLine & s
        End If
    Next s
    Erase strgTemp
Next i
'add column to string
destinationCell.Value = strg

要:

For i = endRow To startRow
    strgTemp = Split(Worksheets("Sheet1").Cells(i, col).Value)
    For Each s In strgTemp
        If strg = "" Then
            strg = s
        Else
            strg = s & vbNewLine & strg
        End If
    Next s
    If strg2 = "" Then
        strg2 = strg
    Else
        strg2 = strg2 & vbNewLine & strg
    End If
    strg = ""
    Erase strgTemp
Next i
'add column to string
destinationCell.Value = strg2

请记住,此更改特定于向后迭代项目并向后重新排序。 columnCombine()子将取决于您希望如何呈现数据

profile for CSAW at Stack Overflow, Q&A for professional and enthusiast programmers