Excel VBA自动化合并和居中,排序

时间:2018-02-21 06:21:54

标签: excel vba excel-vba

我正在尝试在Excel中自动执行报告生成过程。 那么,让我给你们一个背景: - 我的数据表中有3列:
enter image description here

A栏是制造地点

B列是车辆线

C列是进度更新

我试图生成一个报告,该报告将A组中的MFG位置合并并居中,同时在该工厂中使用B列合并和居中车辆线

我附上了我需要的输出样本。截至目前,我正在手动执行此过程,我希望有人可以指导我自动执行此过程

Data Sheet and Output report required

1 个答案:

答案 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

尝试让我知道它是否有效。