VBA 统计合并后的单元格内容方法

来源：互联网发布：房树人绘画心理知乎编辑：程序博客网时间：2024/05/22 07:51

Sub 统计()
Dim R_Output As Range, R_Name As Range, S1 As String, S2 As String, isLast As Boolean, isSameId As Boolean, nCount As Integer
Set R_Output = Range("AF2")
S1 = "": S2 = ""
Set R_Name = Range("A2")
isLast = False
Do
   isLast = (R_Name.Value = "") And (R_Name.Offset(0, 1).Value = "") And (R_Name.Offset(0, 2).Value = "")
    If R_Name.Value <> "" Or isLast Then 'if1 如果不是最后一行，或者不为空，则在输出位置先写入相应的值
     R_Output.Value = R_Name.Value
     R_Output.Offset(0, 1).Value = R_Name.Offset(0, 1).Value
     R_Output.Offset(0, 2).Value = "北京"
     nCount = 0
    'MsgBox R_Name.MergeArea.Rows.Count
    '筛选北京的
    For i = 1 To R_Name.MergeArea.Rows.Count Step 1
    S1 = R_Name.MergeArea.Rows.Cells(i, 22)
    If S1 = "北京" Then
      nCount = nCount + R_Name.MergeArea.Rows.Cells(i, 19)
    End If
    Next i
     R_Output.Offset(0, 3).Value = nCount

     Set R_Output = R_Output.Offset(1, 0)
     R_Output.Value = R_Name.Value
     R_Output.Offset(0, 1).Value = R_Name.Offset(0, 1).Value
     R_Output.Offset(0, 2).Value = "不限"
     nCount = 0
    'MsgBox R_Name.MergeArea.Rows.Count
    '筛选不限京的
    For i = 1 To R_Name.MergeArea.Rows.Count Step 1
    S1 = R_Name.MergeArea.Rows.Cells(i, 22)
    If S1 = "不限" Then
      nCount = nCount + R_Name.MergeArea.Rows.Cells(i, 19)
    End If
    Next i
     R_Output.Offset(0, 3).Value = nCount

    End If 'end if1

    Set R_Output = R_Output.Offset(1, 0)
    Set R_Name = R_Name.Offset(1, 0)

Loop While Not isLast
End Sub