我正在尝试在Excel中自动执行报告生成过程。
那么,让我给你们一个背景: -
我的数据表中有3列:
A栏是制造地点
B列是车辆线
C列是进度更新
我试图生成一个报告,该报告将A组中的MFG位置合并并居中,同时在该工厂中使用B列合并和居中车辆线
我附上了我需要的输出样本。截至目前,我正在手动执行此过程,我希望有人可以指导我自动执行此过程
答案 0 :(得分:0)
此代码可以帮助您提出要求。
Sub MergeSameCells()
Dim Rng As Range
Dim xRows, lastRow As Integer
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Range("A2:C" & lastRow).Select
With ActiveWorkbook.ActiveSheet.Sort
With .SortFields
.Clear
.Add Key:=Range("A2:A" & lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Add Key:=Range("B2:B" & lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Add Key:=Range("C2:C" & lastRow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
End With
.SetRange Range("A2:C" & lastRow)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Set WorkRng = Range("A2:B" & lastRow)
xRows = WorkRng.Rows.Count
If WorkRng Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each Rng In WorkRng.Columns
For i = 1 To xRows - 1
For j = i + 1 To xRows
If Rng.Cells(i, 1).Value <> Rng.Cells(j, 1).Value Then
Exit For
End If
Next
WorkRng.Parent.Range(Rng.Cells(i, 1), Rng.Cells(j - 1, 1)).Merge
i = j - 1
Next
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
尝试让我知道它是否有效。