分门别类

根据给定列的记录，进行分门别类。当然，对于类别不多的情况，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