重新编辑发帖，把大范围区间桩号，划分为按公里为单位的。

胡说V八道

先谢！ 1数据整理.rar (114.43 KB, 下载次数: 21)

2019-6-17 10:24 上传

点击文件名下载附件

dddfr

Sub 桩号分割()
Const ROAD_CODE = 1
Const ROAD_S_POINT = 6
Const ROAD_E_POINT = 7
Const ROAD_LEVEL = 10
Const ROAD_DATA_SHEET = "sheet1"
Const HEADLINE = 4
Const OUTPUT_SHEET = "sheet2"

Dim road_data
Dim output As Range
Set output = Worksheets(OUTPUT_SHEET).[A1]

Dim last_end As Integer
Dim last_level As String
With Worksheets(ROAD_DATA_SHEET)
road_data = .Range(.Cells(HEADLINE + 1, ROAD_CODE), .Cells(HEADLINE, ROAD_LEVEL).End(xlDown))
End With
For i = 1 To UBound(road_data, 1)
    temp = s_point
    code = road_data(i, ROAD_CODE)
    s_point = road_data(i, ROAD_S_POINT)
    e_point = road_data(i, ROAD_E_POINT)
    level = road_data(i, ROAD_LEVEL)
    'If last_end > 0 Then
        If s_point = last_end And level = last_level Then
            output.Offset(-1, 2) = Int(temp)
            s_point = Int(temp)
        End If
    'End If
   
    Do
        If level = "一级" Then
            temparr = Array("上行", "下行")
        ElseIf level = "二级" Then
            temparr = Array("上行")
        End If
        For Each direc In temparr
            output = code
            output.Offset(0, 1) = s_point
            If s_point + 1 > e_point Then
                output.Offset(0, 2) = e_point
            Else
                output.Offset(0, 2) = s_point + 1
            End If
            output.Offset(0, 3) = direc
            Set output = output.Offset(1, 0)
        Next direc
        
        s_point = Int(s_point + 1)
        

    Loop While e_point - s_point >= 0
    last_end = e_point
    last_level = level
   
Next i

End Sub

胡说V八道

dddfr 发表于 2019-6-17 12:14
Sub 桩号分割()
Const ROAD_CODE = 1
Const ROAD_S_POINT = 6

1数据整理.rar (171.14 KB, 下载次数: 1)

2019-6-17 15:01 上传

点击文件名下载附件

有几个地方，运行结果那里，有不符合条件的，我备注了。您抽空看下。

dddfr

Sub 桩号分割()
Const ROAD_CODE = 1
Const ROAD_S_POINT = 6
Const ROAD_E_POINT = 7
Const ROAD_LEVEL = 10
Const ROAD_DATA_SHEET = "sheet1"
Const HEADLINE = 4
Const OUTPUT_SHEET = "sheet2"

Dim road_data
Dim output As Range
Set output = Worksheets(OUTPUT_SHEET).[A1]

Dim last_end As Double
Dim s_point As Double
Dim m_point As Double
Dim e_point As Double
Dim last_level As String

With Worksheets(ROAD_DATA_SHEET)
    road_data = .Range(.Cells(HEADLINE + 1, ROAD_CODE), .Cells(HEADLINE, ROAD_LEVEL).End(xlDown))
End With

For i = 1 To UBound(road_data, 1)
    code = road_data(i, ROAD_CODE)
    s_point = road_data(i, ROAD_S_POINT)
    e_point = road_data(i, ROAD_E_POINT)
    level = road_data(i, ROAD_LEVEL)
   
    If s_point = last_end And level = last_level Then
        output.Offset(-1, 2) = Int(m_point)
        s_point = Int(m_point)
    End If
    m_point = s_point
   
    Do
        If level = "一级" Then
            temparr = Array("上行", "下行")
        ElseIf level = "二级" Then
            temparr = Array("上行")
        End If
        t_point = m_point
        m_point = Int(m_point + 1)
        For Each direc In temparr
            output = code
            output.Offset(0, 1) = t_point
            If m_point > e_point Then
                output.Offset(0, 2) = e_point
            Else
                output.Offset(0, 2) = m_point
            End If
            output.Offset(0, 3) = direc
            Set output = output.Offset(1, 0)
        Next direc
    Loop While e_point - m_point >= 0
    last_end = e_point
    last_level = level
   
Next i

End Sub

胡说V八道

dddfr 发表于 2019-6-18 10:37
Sub 桩号分割()
Const ROAD_CODE = 1
Const ROAD_S_POINT = 6

哥，这个，还有一点问题。但是我找不出问题的原因。例如S203为三级公路，运行结果却出现了上下行，应该只有上行才对。只有一级公路才会出现上行、下行。对于其它等级（二级、三级、四级）都只出现一个上行即可。

dddfr

胡说V八道 发表于 2019-6-20 16:58
哥，这个，还有一点问题。但是我找不出问题的原因。例如S203为三级公路，运行结果却出现了上下行，应该只 ...

把下面这句
ElseIf level = "二级" Then
改为
else

胡说V八道

哥。。想问问题，一时上不了附件。

胡说V八道

dddfr 发表于 2019-6-20 20:51
把下面这句
ElseIf level = "二级" Then
改为

1数据整理（NEW).rar (161.58 KB, 下载次数: 4)

2019-6-25 09:35 上传

点击文件名下载附件

  哥，里面又有了一个新的小问题。感谢你的耐心解答。。

dddfr

把这句
If s_point = last_end And level = last_level Then
改为
If s_point = last_end And (level = last_level Or (level <> "一级" And last_level <> "一级")) Then

胡说V八道

dddfr 发表于 2019-6-25 10:08
把这句
If s_point = last_end And level = last_level Then
改为

1数据整理（6.25).rar (168 KB, 下载次数: 7)

2019-6-25 11:27 上传

点击文件名下载附件

  哥，哥，又来了小问题。。。 就是连续“一级”的，也不断开！