这是我现在的代码,如何讲部门那一列内容一样的单元格合并?
Dim uExcel As Excel.Application
Dim uExcelBook As Excel.Workbook
Dim intI As Integer
Dim intFgRow As Integer
If fgEmployee.Rows > 1 Then
    Set uExcel = New Excel.Application
    uExcel.Visible = False
    uExcel.SheetsInNewWorkbook = 1
    
    Set uExcelBook = uExcel.Workbooks.Add
    With uExcel.Rows(1).Font
        .Name = "宋体"
        .Size = 9
        .ColorIndex = 3
    End With
    uExcel.ActiveSheet.Rows.HorizontalAlignment = xlVAlignCenter
    uExcel.ActiveSheet.Rows.VerticalAlignment = xlVAlignCenter    uExcel.Columns(1).ColumnWidth = 9
    uExcel.ActiveSheet.Cells(1, 1).Value = "序号"
        
    For intFgRow = 1 To intColsCount
        uExcel.Columns(intFgRow + 1).ColumnWidth = 11
        uExcel.ActiveSheet.Cells(1, intFgRow + 1).Value = "部门"
    Next
    
    uExcel.Columns(intColsCount + 2).ColumnWidth = 40
    uExcel.ActiveSheet.Cells(1, intColsCount + 2).Value = "员工"
    
    uExcel.Columns(intColsCount + 3).ColumnWidth = 40
    uExcel.ActiveSheet.Cells(1, intColsCount + 3).Value = "合计"End If
For intI = 1 To fgEmployee.Rows - 1
    With uExcel.Rows(intI + 1).Font
        .Name = "宋体"
        .Size = 9
        .ColorIndex = 1
    End With
    For intFgRow = 1 To fgEmployee.Cols - 1
        uExcel.ActiveSheet.Cells(intI + 1, intFgRow).Value = Trim(fgEmployee.TextMatrix(intI, intFgRow))
    Next
Next
uExcelBook.SaveAs (strFileName)
uExcel.Quit
uExcel.DisplayAlerts = True
Set uExcel = Nothing
Set uExcelBook = Nothing

解决方案 »

  1.   

    先计算要合并从哪到哪。然后用代码实现以下是我录的一段excel的宏,作用是将C2到C7的单元格合并。  Range("C2:C7").Select
        With Selection
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = True
        End With
    放在vb中使用的时候为:    with uExcelBook.Worksheets(1).Range("C2:C7")
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = True
        End With