Warning: file_get_contents(/data/phpspider/zhask/data//catemap/4/video/2.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Excel 如何将随机数目的单元格与列中的空白单元格合并?_Excel_Vba_Cell - Fatal编程技术网

Excel 如何将随机数目的单元格与列中的空白单元格合并?

Excel 如何将随机数目的单元格与列中的空白单元格合并?,excel,vba,cell,Excel,Vba,Cell,我的数据集示例: blank 1 2 blank 3 4 5 blank 6 我想将空白单元格下的所有单元格合并到空白单元格中,但在到达下一个空白单元格时停止计数。 最终结果应该是这样的,字符串连接在一起 12 345 6 我目前正在尝试创建一个包含1和2的数组,其中2表示为空白单元格,然后计算1并合并它们。我不知道这是否可行,或者是否有更简单的方法来实现这一点。如果我们从以下方面开始: 并运行此宏: 我们最终得到: 编辑1: 要修复连接单元

我的数据集示例:

blank  
1  
2  
blank  
3  
4  
5  
blank   
6
我想将空白单元格下的所有单元格合并到空白单元格中,但在到达下一个空白单元格时停止计数。 最终结果应该是这样的,字符串连接在一起

12  
345  
6  
我目前正在尝试创建一个包含1和2的数组,其中2表示为空白单元格,然后计算1并合并它们。我不知道这是否可行,或者是否有更简单的方法来实现这一点。

如果我们从以下方面开始:

并运行此宏:

我们最终得到:

编辑1:

要修复连接单元格的顺序,请改为使用以下命令:

Sub PileOn()
Dim N As Long, st As String
Dim i As Long, v As Variant
N = Cells(Rows.Count, "A").End(xlUp).Row

For i = N To 1 Step -1
   v = Cells(i, 1).Value
   If v <> "" Then
      st = v & st
      Cells(i, 1).Delete shift:=xlUp
   Else
      Cells(i, 1).Value = st
      st = ""
   End If
Next i
End Sub

这要求您选择要合并的区域,从第一个空白单元格开始,到最后一个有值的单元格结束。它将删除整行;不确定这是否是您想要的:

Sub MergeConstantsIntoEmpties()
Dim BlankCells As Excel.Range
Dim ConstantCells As Excel.Range
Dim i As Long
Dim MungedContents As String

With Selection
    Set BlankCells = .SpecialCells(xlCellTypeBlanks)
    Set ConstantCells = .SpecialCells(xlCellTypeConstants)
End With

For i = 1 To BlankCells.Areas.Count
    If ConstantCells.Areas(i).Count = 1 Then
        MungedContents = ConstantCells.Areas(i).Value
    Else
        MungedContents = Join(Application.WorksheetFunction.Transpose(ConstantCells.Areas(i).Value))
    End If
    BlankCells.Areas(i).Value = MungedContents
Next i
ConstantCells.EntireRow.Delete
End Sub
这是我的看法

Sub JoinBetweenTheLines()
Dim X As Long
X = 1
Do Until X >= Range("A" & Rows.Count).End(xlUp).Row
    If Range("A" & X).text = "" Then
        Range("A" & X).Delete xlUp
    ElseIf Range("A" & X).Offset(1, 0).text = "" Then
        X = X + 1
    Else
        Range("A" & X).Formula = Join(Application.Transpose(Range("A" & X & ":A" & X + 1)), "")
        Range("A" & X + 1).Delete xlUp
    End If
Loop
End Sub

我通常也向后工作,但这次是向前的。

我脑子里想着记忆处理

Sub merg()
    Dim v As Long, w As Long, vVALs As Variant
    With ActiveSheet    'reference the worksheet properly!
        With .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
            vVALs = .Cells.Value2
            For v = LBound(vVALs, 1) To UBound(vVALs, 1)
                If vVALs(v, 1) = vbNullString Then
                    For w = v + 1 To UBound(vVALs, 1)
                        If vVALs(w, 1) = vbNullString Then Exit For
                        vVALs(v, 1) = vVALs(v, 1) & vVALs(w, 1)
                        vVALs(w, 1) = vbNullString
                    Next w
                End If
            Next v
            .Cells = vVALs
            With .SpecialCells(xlCellTypeBlanks)
                .Delete Shift:=xlUp
            End With
        End With
    End With
End Sub

一个最终结果的例子会很有帮助。@Douglancy谢谢,nowDude补充道,它是从后到前的,你需要根据OP中的例子镜像数字:@DanDonoghue OUCH-你是对的-我会修正-谢谢!
Sub merg()
    Dim v As Long, w As Long, vVALs As Variant
    With ActiveSheet    'reference the worksheet properly!
        With .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
            vVALs = .Cells.Value2
            For v = LBound(vVALs, 1) To UBound(vVALs, 1)
                If vVALs(v, 1) = vbNullString Then
                    For w = v + 1 To UBound(vVALs, 1)
                        If vVALs(w, 1) = vbNullString Then Exit For
                        vVALs(v, 1) = vVALs(v, 1) & vVALs(w, 1)
                        vVALs(w, 1) = vbNullString
                    Next w
                End If
            Next v
            .Cells = vVALs
            With .SpecialCells(xlCellTypeBlanks)
                .Delete Shift:=xlUp
            End With
        End With
    End With
End Sub