根据给定列的记录,进行分门别类。当然,对于类别不多的情况,EXCEL直接筛选,复制粘贴更直观、快捷吧。
Option Explicit
Sub Classify()
Dim r As Long, c As Long, i As Integer
Dim wu_liu As Long, gao_sheng As Long, gui_hua As Long
Dim long_feng As Long, nan_jin As Long, yong_xing As Long, yu_cai As Long
Dim myRange As Range, CopyRange As Range
Dim myFon As Font
'r为行数,c为列数,i为循环数控制
Set myRange = ActiveSheet.UsedRange
'myRange.ClearFormats
r = myRange.Rows.Count
c = myRange.Columns.Count
wu_liu = 1: gao_sheng = 1: gui_hua = 1: long_feng = 1: nan_jin = 1
yong_xing = 1: yu_cai = 1
'新建工作表
' Worksheets.Add After:=Sheets(Sheets.Count)
' Worksheets(Sheets.Count).Name = "物流港"
' Worksheets.Add After:=Sheets(Sheets.Count)
' Worksheets(Sheets.Count).Name = "高升"
'
' Worksheets.Add After:=Sheets(Sheets.Count)
' Worksheets(Sheets.Count).Name = "桂花"
'
' Worksheets.Add After:=Sheets(Sheets.Count)
' Worksheets(Sheets.Count).Name = "龙凤"
'
' Worksheets.Add After:=Sheets(Sheets.Count)
' Worksheets(Sheets.Count).Name = "南津路"
'
' Worksheets.Add After:=Sheets(Sheets.Count)
' Worksheets(Sheets.Count).Name = "永兴"
'
' Worksheets.Add After:=Sheets(Sheets.Count)
' Worksheets(Sheets.Count).Name = "育才"
'根据第七列属地划分情况进行分类
For i = 2 To r
Select Case myRange.Cells(i, 7).Value
Case Is = "物流港"
'复制
Set CopyRange = myRange.Cells(i, 1).Resize(1, c)
CopyRange.Copy Worksheets("物流港").Cells(wu_liu, 1)
wu_liu = wu_liu + 1
Case Is = "物流"
Set CopyRange = myRange.Cells(i, 1).Resize(1, c)
CopyRange.Copy Worksheets("物流港").Cells(wu_liu, 1)
wu_liu = wu_liu + 1
Case Is = "高升"
Set CopyRange = myRange.Cells(i, 1).Resize(1, c)
CopyRange.Copy Worksheets("高升").Cells(gao_sheng, 1)
gao_sheng = gao_sheng + 1
Case Is = "桂花"
Set CopyRange = myRange.Cells(i, 1).Resize(1, c)
CopyRange.Copy Worksheets("桂花").Cells(gui_hua, 1)
gui_hua = gui_hua + 1
Case Is = "龙凤"
Set CopyRange = myRange.Cells(i, 1).Resize(1, c)
CopyRange.Copy Worksheets("龙凤").Cells(long_feng, 1)
long_feng = long_feng + 1
Case Is = "南津"
Set CopyRange = myRange.Cells(i, 1).Resize(1, c)
CopyRange.Copy Worksheets("南津路").Cells(nan_jin, 1)
nan_jin = nan_jin + 1
Case Is = "南津路"
Set CopyRange = myRange.Cells(i, 1).Resize(1, c)
CopyRange.Copy Worksheets("南津路").Cells(nan_jin, 1)
nan_jin = nan_jin + 1
Case Is = "永兴"
Set CopyRange = myRange.Cells(i, 1).Resize(1, c)
CopyRange.Copy Worksheets("永兴").Cells(yong_xing, 1)
yong_xing = yong_xing + 1
Case Is = "永兴镇"
Set CopyRange = myRange.Cells(i, 1).Resize(1, c)
CopyRange.Copy Worksheets("永兴").Cells(yong_xing, 1)
yong_xing = yong_xing + 1
Case Is = "育才"
Set CopyRange = myRange.Cells(i, 1).Resize(1, c)
CopyRange.Copy Worksheets("育才").Cells(yu_cai, 1)
yu_cai = yu_cai + 1
End Select
Next
Debug.Print r - 1
Debug.Print wu_liu
Debug.Print gao_sheng
Debug.Print gui_hua
Debug.Print long_feng
Debug.Print nan_jin
Debug.Print yong_xing
Debug.Print yu_cai
Debug.Print wu_liu + gao_sheng + gui_hua + long_feng + _
nan_jin + yong_xing + yu_cai
End Sub