vba在一个单元格中合并几行

时间:2018-06-22 14:10:06

标签: vba

我在excel中有三列,其中包含诸如

section1     section2     section3     
 no             no          er3       
 er1            no          er3    
 no             no          no

如何编写宏以合并on列中的数据,例如:

section_error    
    er3        
    er1,er3        
    no

因此,如果只有“否”,则应该只有一次“否” 如果除“ no”之外还有其他内容,例如“ er1”或“ er3”,则仅列出其他符号。 它并不完全是加入或CONCATENATE(

3 个答案:

答案 0 :(得分:0)

这是一个宏解决方案,只是循环遍历行/列:

Sub Test()

Dim i As Long, j As Long, lastrow As Long
Dim mystring As String

lastrow = Worksheets("ICS Analysis").Cells(Worksheets("ICS Analysis").Rows.Count, 1).End(xlUp).Row

For i = 2 To lastrow
    For j = 1 To 3
        If InStr(Worksheets("ICS Analysis").Cells(i, j).Value, "er") > 0 Then
            If mystring = "" Then
                mystring = Worksheets("ICS Analysis").Cells(i, j).Value
            Else
                mystring = mystring & "," & Worksheets("ICS Analysis").Cells(i, j).Value
            End If
        End If
    Next j

    If mystring <> "" Then
        Worksheets("ICS Analysis").Cells(i, 4).Value = mystring
        mystring = ""
    Else
        Worksheets("ICS Analysis").Cells(i, 4).Value = "no"
    End If

Next i

End Sub

img1

答案 1 :(得分:0)

因此,根据您拥有的行数,这可能有点过大。但是,如果您开始数以千计的话,使用数组将会更快。

无论如何,我们定义两个命名范围,输入和输出。然后,我们将输入范围的值放入数组中。

我们遍历数组,检查数组中那些斑点的值(现在对应于单元格中的值)。找到某些内容后,便将该内容附加到该行的输出值的末尾。当我们找不到任何东西时,我们将该值设置为no。

最后,我们将输出范围的值(为数组调整大小)设置为等于输出数组的值。

确保您定义了这些命名范围(并也更改了它们的名称!)。

让我知道您是否有疑问。

Option Explicit

Sub combineColumns()
    Dim combineRange As Range, pasteRange As Range
    Dim inputArr() As Variant, outputArr() As Variant, i As Long, j As Long, numberOfRows As Long
    Dim currentOutputvalue As String

    'Named range with values to combine, don't include header
    Set combineRange = Range("yourNamedRangeToCombineHere")
    'only need to set the top of the range to paste
    Set pasteRange = Range("theCellAtTheTopOfWhereYouWantToPaste")

    'put the values of the range you want to combine into the input array
    inputArr = combineRange.Value2

    'find the size of the array
    numberOfRows = UBound(inputArr, 1)

    'dimension the output array, same number of rows, but only one column
    ReDim outputArr(1 To numberOfRows, 1 To 1)

    'loop through our rows
    For i = 1 To numberOfRows

        'set the current output value to a blank
        currentOutputvalue = ""

        'loop through our three columns
        For j = 1 To 3
            'if cell value is not no, append the value to the end of current output value
            'also append a comma
            If inputArr(i, j) <> "no" Then
                currentOutputvalue = currentOutputvalue & inputArr(i, j) & ","
            End If
        Next

        If currentOutputvalue = "" Then
            'all columns in this row were "no", so change value to "no"
            currentOutputvalue = "no"
        Else
            'there was at least one not no
            'trim off the end comma
            currentOutputvalue = Left(currentOutputvalue, Len(currentOutputvalue) - 1)
        End If

        'assign the value to the spot in the array
        outputArr(i, 1) = currentOutputvalue
    Next

    'resize the pasterange to the size of the array, and
    'set the values of the range to those in the output array
    pasteRange.Resize(numberOfRows, 1).Value2 = outputArr

End Sub

答案 2 :(得分:0)

您可以使用UDF执行此操作。请注意,以下方法可行,但可能可以优化。如果不需要重新计算函数,可以杀死Application.Volatile

Option Explicit
Function CombineData(rng As Range) As String
    Application.Volatile

    Dim tmpRng As Range

    If WorksheetFunction.CountIf(rng, "no") = rng.Count Then
        CombineData = "no"
    Else
        For Each tmpRng In rng
            If tmpRng.Value <> "no" Then
                If Len(CombineData) = 0 Then
                    CombineData = CombineData & tmpRng.Value
                Else
                    CombineData = CombineData & "," & tmpRng.Value
                End If
            End If
        Next tmpRng
    End If
End Function