VB导出EXCEL合并问题及单元格颜色请教

[awei2324]

Set mrc1 = ExecuteSQL(sqltxt, sqlmsg)
    Dim J As Integer
    Dim ex As Object
    Dim exwbook As Object
    Dim exsheet As Object
    Set ex = CreateObject("Excel.Application")    '创建EXCEL对象
    Set exwbook = ex.Workbooks.Add                '打开文件
    ex.Visible = False
    Set exsheet = exwbook.Worksheets("sheet1")    '设定工作表
   '获取列名称
    For J = 1 To mrc1.Fields.count
       exsheet.Cells(2, J) = mrc1.Fields(J - 1).name
    Next J
    '导出excel
    
    exsheet.range("A3").copyfromrecordset mrc1
    '***************************************
    exsheet.range("a1:k1").Merge
    exsheet.Cells(1, 1) = "易耗品出库汇总报表"
    exsheet.range("A1:k1").HorizontalAlignment = -4108
    Dim iRow1 As Long
    Dim iRow2 As Long
    Dim sGroupText As String
    exsheet.Application.DisplayAlerts = False
    iRow1 = 3
    sGroupText = exsheet.Cells(iRow1, 2).Value
    iRow2 = iRow1
    While LenB(sGroupText) <> 0
        iRow2 = iRow2 + 1
            If exsheet.Cells(iRow2, 2).Value <> sGroupText Then '一组结束'
            If iRow2 - iRow1 > 1 Then
                exsheet.range("A" & iRow1 & ":A" & (iRow2)).Merge
                exsheet.range("B" & iRow1 & ":B" & (iRow2 - 1)).Merge
                exsheet.range("C" & iRow1 & ":C" & (iRow2 - 1)).Merge
                exsheet.range("D" & iRow1 & ":D" & (iRow2 - 1)).Merge
                exsheet.range("E" & iRow1 & ":E" & (iRow2 - 1)).Merge
            End If
            
            '新开始一组'
            iRow1 = iRow2
            sGroupText = exsheet.Cells(iRow1, 2).Value
            exsheet.range("A2:k" & iRow2).borders.Weight = 2
        End If
    Wend
    exsheet.Application.DisplayAlerts = True
    '***************************************
    ex.Visible = True

代码经过修改后，可以合并了，但是当序号相同的只有一行的时候，没有合并，想要当数据只有一行的时候，序号列合并到序号1的小计，2合并到2的小计，然后如何给小计和合计填充不同的颜色呢？谢谢了。

[Tiger_Zhao]

    While LenB(sGroupText) <> 0
        iRow2 = iRow2 + 1
        If exsheet.Cells(iRow2, 2).Value <> sGroupText Then '一组结束'
            exsheet.range("A" & iRow1 & ":A" & (iRow2)).Merge '<-序号提出来，始终合并'
            If iRow2 - iRow1 > 1 Then
                exsheet.range("B" & iRow1 & ":B" & (iRow2 - 1)).Merge
                exsheet.range("C" & iRow1 & ":C" & (iRow2 - 1)).Merge
                exsheet.range("D" & iRow1 & ":D" & (iRow2 - 1)).Merge
                exsheet.range("E" & iRow1 & ":E" & (iRow2 - 1)).Merge
            End If
            
            设置小计颜色(iRow2)
            
            '新开始一组'
            iRow2 = iRow2 + 1 '<-跳过小计'
            iRow1 = iRow2
            sGroupText = exsheet.Cells(iRow1, 2).Value
            exsheet.range("A2:k" & iRow2).borders.Weight = 2
        End If
    Wend
    设置合计颜色(iRow2)

设置颜色的两个语句自己写

[awei2324]

[q[[b]b]uote=引用 1 楼 Tiger_Zhao 的回复:]

While LenB(sGroupText) <> 0
        iRow2 = iRow2 + 1
            If exsheet.Cells(iRow2, 2).Value <> sGroupText Then '一组结束'
            exsheet.Range("A" & iRow1 & ":A" & (iRow2)).Merge
            If iRow2 - iRow1 > 1 Then
                exsheet.Range("A" & iRow1 & ":A" & (iRow2)).Merge
                exsheet.Range("B" & iRow1 & ":B" & (iRow2 - 1)).Merge
                exsheet.Range("C" & iRow1 & ":C" & (iRow2 - 1)).Merge
                exsheet.Range("D" & iRow1 & ":D" & (iRow2 - 1)).Merge
                exsheet.Range("E" & iRow1 & ":E" & (iRow2 - 1)).Merge
            End If
            '设置小计颜色 (iRow2)
            exsheet.Range("B" & iRow2 & ":k" & iRow2).Interior.ColorIndex = 6
            '新开始一组'
            iRow2 = iRow2 + 1 '<-跳过小计'
            iRow1 = iRow2
            sGroupText = exsheet.Cells(iRow1, 2).Value
            exsheet.Range("A2:k" & (iRow1 - 2)).borders.Weight = 2
        End If
    Wend
     '设置合计颜色 (iRow2)
    exsheet.Range("B" & (iRow2 - 2) & ":k" & (iRow2 - 2)).Interior.ColorIndex = 4
    exsheet.Application.DisplayAlerts = True
    exsheet.Columns.autofit
    '******************************************************************************
    ex.Visible = True

代码再次修改如下，但是，怎么会多出最后一行黄色的呢？

[Tiger_Zhao]

文本“合计”被当作一个分组了。

While (LenB(sGroupText) <> 0)AND(sGroupText <> "合计")