如何将随机数量的单元格与列中的空白单元格合并?
How do I merge a random number of cells with a blank cell in a column?
我的数据集示例:
blank
1
2
blank
3
4
5
blank
6
我想将空白单元格下方的所有单元格合并到空白单元格中,但当它到达下一个空白单元格时停止计数。
最终结果应该是这样的,字符串连接在一起
12
345
6
我目前正在尝试创建一个包含 1 和 2 的数组,其中 2 表示它是一个空白单元格,然后对 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 = 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
这需要您 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
这是我的看法。
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
我的数据集示例:
blank
1
2
blank
3
4
5
blank
6
我想将空白单元格下方的所有单元格合并到空白单元格中,但当它到达下一个空白单元格时停止计数。
最终结果应该是这样的,字符串连接在一起
12
345
6
我目前正在尝试创建一个包含 1 和 2 的数组,其中 2 表示它是一个空白单元格,然后对 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 = 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
这需要您 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
这是我的看法。
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