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

我的数据集示例：

blank 1 2 blank 3 4 5 blank 6 

我想合并空白单元格下的所有单元格到空白单元格，但是当到达下一个空白单元格时停止计数。

最终结果应该看起来像这样，连接string

 12 345 6 

我目前正在尝试创build一个数组1和2，其中2表示一个空白单元格，然后数1并合并它们。 我不知道这是否会起作用，或者是否有更简单的方法来做到这一点。

Answer 1

这要求您select要合并的区域，从第一个空白单元格开始，到最后一个单元格的值结束。 它会删除整行; 不知道这是你想要的：

 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 

Answer 2

如果我们从以下开始：

并运行这个macros：

 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 = st & v Cells(i, 1).Delete shift:=xlUp Else Cells(i, 1).Value = st st = "" End If Next i End Sub 

我们结束了：

编辑＃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 

Answer 3

这是我的承担。

 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 

我通常也会倒退，但是这个人往前走。

Answer 4

我有记忆处理的想法。

 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