数据情况

要求

分表汇总

代码

Public Sub fenlei()

Dim i, a, b, c, d, e As Integer
Dim arr
a = 2
b = 2
c = 2
d = 2
e = 2
row_num = Cells(Rows.Count, 3).End(xlUp).Row
arr = Range("b3:i3")

Worksheets.Add.Name = "长虹湖-进水口"
Worksheets.Add.Name = "长虹湖-出水口"
Worksheets.Add.Name = "长虹湖-东北侧"
Worksheets.Add.Name = "华工西湖"
Worksheets.Add.Name = "水校"

For i = 4 To row_num
If Range("C" & i).Value = "长虹湖-进水口" Then
    'Sheets("长虹湖-进水口").Range("a" & a) = Range("b" & i)
    Range("b" & i & ":i" & i).Copy Sheets("长虹湖-进水口").Range("a" & a)
    a = a + 1

ElseIf Range("C" & i).Value = "长虹湖-出水口" Then
    'Sheets("长虹湖-出水口").Range("a" & b) = Range("b" & i)
    Range("b" & i & ":i" & i).Copy Sheets("长虹湖-出水口").Range("a" & b)
    b = b + 1
    
ElseIf Range("C" & i).Value = "长虹湖-东北侧" Then
    'Sheets("长虹湖-东北侧").Range("a" & c) = Range("b" & i)
    Range("b" & i & ":i" & i).Copy Sheets("长虹湖-东北侧").Range("a" & c)
    c = c + 1
ElseIf Range("C" & i).Value = "华工西湖" Then
    'Sheets("长虹湖-出水口").Range("a" & d) = Range("b" & i)
    Range("b" & i & ":i" & i).Copy Sheets("华工西湖").Range("a" & d)
    d = d + 1
Else
    'Sheets("长虹湖-出水口").Range("a" & f) = Range("b" & i)
    Range("b" & i & ":i" & i).Copy Sheets("水校").Range("a" & e)
    e = e + 1

End If

Next

Sheets("长虹湖-进水口").Range("a1").Resize(1, 8) = arr
Sheets("长虹湖-出水口").Range("a1").Resize(1, 8) = arr
Sheets("长虹湖-东北侧").Range("a1").Resize(1, 8) = arr
Sheets("华工西湖").Range("a1").Resize(1, 8) = arr
Sheets("水校").Range("a1").Resize(1, 8) = arr

MsgBox "分类完毕"

End Sub

标签：vba,长虹,位置,汇总,arr,出水口,Range,Sheets,Add
来源： https://blog.csdn.net/weixin_40112836/article/details/118279525