如何在excel中合并虚线

我有一个包含数千行的excel表格。 第一列中的一些行被破坏。 没有虚线总是有与其中的数据相邻列。 虚线不。 换句话说，我如何转换以下内容：

进入这个：

Answer 1

这里是您所要求的更改的代码块。 我决定只是基于（1）你不知道VBA编码的事实，以及（2）我不知道你真正知道的是什么编码的事实，来replace整个代码块。 对于没有编码经验的人来说，完成replace比编辑更容易。

Dim MaxRow As Integer Sub MergeRows() Dim Ptr As Integer Dim I As Integer Dim WorkStr As String Dim S As String Dim Space As String ActiveSheet.Cells(1, 1).Activate ' Move to the first cell GetMaxRow ' Get the last row in the worksheet ActiveSheet.Cells(1, 1).Activate ' Move to the first cell Ptr = 0 I = 0 For I = 1 To MaxRow If ActiveSheet.Cells(I, 1).Value > "" Then If ActiveSheet.Cells(I, 2).Value > "" Then Ptr = I Else If Ptr > 0 Then Space = " " WorkStr = ActiveSheet.Cells(Ptr, 1).Value S = ActiveSheet.Cells(I, 1).Value If Right(WorkStr, 1) = "-" Then WorkStr = Left(WorkStr, Len(WorkStr) - 1) Space = "" End If If Left(S, 1) = "-" Then S = Right(S, Len(S) - 1) Space = "" End If ActiveSheet.Cells(Ptr, 1).Value = WorkStr & IIf(Right(WorkStr, 1) = " " Or Left(S, 1) = " ", "", Space) & S End If ActiveSheet.Cells(I, 1).Value = "" End If End If Next I End Sub Sub GetMaxRow() ' MaxRow = ActiveCell.SpecialCells(xlLastCell).Row End Sub 

Answer 2

这些是您要遵循的步骤。 在做任何这些之前，您应该制作电子表格的备份副本。

• 打开您的Excel电子表格。

• 确保您要处理的工作表是活动工作表

  • 这将是确保您拥有原始数据文件的备份的好时机。
• 点击文件/选项/自定义function区
• 在checkbox的右侧列表中，如果未选中开发人员checkbox，请检查它
• 点击[确定]
• 点击开发者标签
• 双击Visual Basic图标
• 在popup的窗口上，右键单击当前工作簿名称下的Microsoft Excel对象条目。 然后从popup菜单中select插入 – >模块。 它应该看起来像这样：

• 插入工作簿之后，此树将看起来更像这样：

• 您也将有一个子窗口，可能标题为[工作簿名称] – 模块1（代码） 。 这是VBA代码将被放置的地方。 复制下面的代码：

---

 Dim MaxRow As Integer Sub MergeRows() Dim Ptr As Integer Dim I As Integer ActiveSheet.Cells(1, 1).Activate ' Move to the first cell GetMaxRow ' Get the last row in the worksheet ActiveSheet.Cells(1, 1).Activate ' Move to the first cell Ptr = 0 I = 0 For I = 1 To MaxRow If ActiveSheet.Cells(I, 1).Value > "" Then If ActiveSheet.Cells(I, 2).Value > "" Then Ptr = I Else If Ptr > 0 Then ActiveSheet.Cells(Ptr, 1).Value = ActiveSheet.Cells(Ptr, 1).Value & ActiveSheet.Cells(I, 1).Value ActiveSheet.Cells(I, 1).Value = "" End If End If Next I End Sub Sub GetMaxRow() ' MaxRow = ActiveCell.SpecialCells(xlLastCell).Row End Sub 

---

• 将复制的代码粘贴到空的Module1窗口中。
• 点击Dim Ptr As Integer
• 按F5
• 等待几秒钟
• closures模块。 如果要保存代码，则取决于您，但在此工作簿中可能再也不需要它了。 只要保存这个问题的参考…以防万一。
• closuresMicrosoft Visual Basic for Applications窗口。
• validation您的数据。

如果有任何问题，更新这个答案，我会检查出来。

Answer 3

如果我们从以下开始：

并运行这个短的macros：

 Sub Kompaktor() Dim i As Long, N As Long, IDidSomething As Boolean With Application.WorksheetFunction N = Cells(Rows.Count, 1).End(xlUp).Row IDidSomething = True While IDidSomething IDidSomething = False For i = N To 2 Step -1 If Cells(i, 1).Value <> "" And .CountA(Range(Cells(i, 2), Cells(i, 7))) = 0 Then IDidSomething = True Cells(i - 1, 1).Value = Cells(i - 1, 1).Value & " " & Cells(i, 1).Value Cells(i, 1).Value = "" End If Next i Wend End With End Sub 

我们将最终：

Answer 4

SpecialCells()在这里可以非常方便：

 Option Explicit Sub main() Dim cell As Range With Range("A1", Cells(Rows.count, 1).End(xlUp)).SpecialCells(xlCellTypeConstants, xlTextValues) For Each cell In .Offset(, 1).SpecialCells(xlCellTypeBlanks).Offset(, -1) With IIf(IsEmpty(cell.Offset(-1)), cell.End(xlUp), cell.Offset(-1)) .Value = IIf(Right(.Value, 1) = "-", Left(.Value, Len(.Value) - 1), .Value & " ") & cell.Value End With cell.ClearContents Next cell End With End Sub