合并具有先前值的空单元格

我有一个大约有100,000条logging的Excel文件。 我有6列，其中前五个是：

所需格式：

到目前为止我有：

Sub Main() Dim i As Long Dim j As Long Dim sameRows As Boolean sameRows = True For i = 1 To Range("A" & Rows.Count).End(xlUp).Row For j = 1 To 4 If StrComp(Cells(i, j), Cells(i + 1, j), vbTextCompare) Then sameRows = False End If Next j If sameRows Then Range(Cells(i, 4), Cells(i + 1, 4)).merge End If sameRows = True Next i End Sub 

我可以通过改变范围从4到1/2/3/4的值，并运行macros四次运行macros得到以下。

请帮助我获取所需格式的数据。 我仍然需要将空字段与以前的非空字段合并。

Answer 1

Pratik，仔细听着Jeeped。 在Excel中处理大量数据并不理想，在合并的单元格中处理原始数据正在凝视着深渊 – 这是一个黑暗而黑暗的地方， Range引用和诸如Offset函数之类的东西会向您展示您从来不知道存在的绝望的维度。

如果您有另一种格式的数据，比如XML，那么您已经导入到Excel中，然后使用VBA以原始格式读取数据，查询数据等等。 如果它存在于数据库中，那么再次使用VBA来访问该数据库，并根据需要操作logging集。 如果这是您唯一的数据源，那么为什么不把它写入XML文档或VBA自己的数据存储选项（如Collection或数组）。

如果您必须使用Excel，则不要将原始数据与数据显示混淆。 是的，合并的单元格可能更易于人眼阅读，但是我只是提出这个问题：这是您执行合并的主要目标吗？

如果你必须进入深渊 – 你可以看到至less有两个人会提出反对意见 – 然后至less通过从一个数组中读取数据并合并行来加快速度：

 Sub OpenDoorsToHades() Dim dataSheet As Worksheet Dim v As Variant Dim mergeCells As Range Dim mergeAreas As Range Dim i As Long Dim blankStart As Long Dim blankEnd As Long Dim doMerge As Boolean Dim c As Integer Set dataSheet = ThisWorkbook.Worksheets("data") 'rename to your sheet 'Read values into array of variants With dataSheet v = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).Value2 End With 'Check for blanks For i = 1 To UBound(v, 1) If IsEmpty(v(i, 1)) Then If Not doMerge Then blankStart = i - 1 doMerge = True End If Else If doMerge Then blankEnd = i - 1 For c = 1 To 4 With dataSheet Set mergeCells = .Range( _ .Cells(blankStart, c), _ .Cells(blankEnd, c)) If mergeAreas Is Nothing Then Set mergeAreas = mergeCells Else Set mergeAreas = .Range(mergeAreas.Address & _ "," & mergeCells.Address) End If End With Next mergeAreas.Merge Set mergeAreas = Nothing doMerge = False End If End If Next 'Format the sheet dataSheet.Cells.VerticalAlignment = xlCenter Application.ScreenUpdating = True End Sub 

Answer 2

如何只填充上面的值的空单元格，所以最右边的值与合并单元格中的相同的值相关联。 例如，如果19位于单元格A2中，则可以使用= IF（A2 <>“”，A2，G1）从G2开始重新创build表格，这样所有空单元格将填充上面的值，将值在最右边，具有完全相同的值。

Answer 3

我本周也自己解决了同样的问题。 Ambie的解决scheme似乎过于复杂，所以我写了一些非常简单的事情来合并行：

 Sub MergeRows() Sheets("Sheet1").Select Dim lngStart As Long Dim lngEnd As Long Dim myRow As Long 'Disable popup alerts that appear when merging rows like this Application.DisplayAlerts = False lngStart = 2 lngEnd = 2 For myRow = 2 To Range("A" & Rows.Count).End(xlUp).Row 'last row If Range("A" & (myRow + 1)).value = "" Then 'include row below in next merge lngEnd = myRow + 1 Else 'merge if 2+ rows are included If lngEnd - lngStart > 0 Then Range("A" & lngStart & ":A" & lngEnd).Merge Range("B" & lngStart & ":B" & lngEnd).Merge Range("C" & lngStart & ":C" & lngEnd).Merge Range("D" & lngStart & ":D" & lngEnd).Merge End If 'reset included rows lngStart = myRow + 1 lngEnd = myRow + 1 End If Next myRow Application.DisplayAlerts = True End Sub