OCR转表错误，补齐兰州地铁票价表正确数据。

ning84

兰州地铁采用“里程分段计价”的收费方式，起步价2元，起步里程4公里（含4公里），晋级里程为“4、4、6、6、8、8”，即3元可乘坐8公里、4元12公里、5元18公里、6元24公里、7元32公里、8元40公里，40公里以上每加1元可乘8公里。
兰州地铁的收费价目表是根据乘客乘坐的距离来计算票价的。以下是具体的收费标准：

起步价：2元，可乘坐4公里（含4公里）。
晋级里程：“4、4、6、6、8、8”，即：
3元可乘坐8公里。
4元可乘坐12公里。
5元可乘坐18公里。
6元可乘坐24公里。
7元可乘坐32公里。
8元可乘坐40公里。
40公里以上每加1元可乘8公里





OCR转换的数据有错误。



各站的距离是数据是正确的。

1. Sub ll()
   
2.    Dim StationArr
   
3.    StationArr = Array("陈官营", "深安大桥南", "兰州城市学院", "兰州海关", "马滩", "土门墩", "兰州西站北广场", "西站什字", "七里河", "小西湖", "文化宫", "西关", "省政府", "东方红广场", "兰州大学", "五里铺", "省气象局", "携星墩", "焦家湾", "东岗")
   
4.    DistArr = Array(0, 1579, 2340, 955, 2073, 2007, 907, 1614, 1060, 1376, 890, 1066, 969, 1456, 1426, 1293, 1303, 1163, 1116, 933)
   
5.    
   
6.    
   
7. End Sub

复制代码

要做的事，分解各个站点的组合。
"陈官营"----- "焦家湾"
"东岗" ---- "兰州海关"

ning84

第一步解决的问题
排除这两个组合。

1. Sub ll()
   
2.    Dim StationArr, Str, Str1
   
3.    Dim Rng As Range
   
4.    StationArr = Array("陈官营", "深安大桥南", "兰州城市学院", "兰州海关", "马滩", "土门墩", "兰州西站北广场", "西站什字", "七里河", "小西湖", "文化宫", "西关", "省政府", "东方红广场", "兰州大学", "五里铺", "省气象局", "携星墩", "焦家湾", "东岗")
   
5.    DistArr = Array(0, 1579, 2340, 955, 2073, 2007, 907, 1614, 1060, 1376, 890, 1066, 969, 1456, 1426, 1293, 1303, 1163, 1116, 933)
   
6.    Dim Rr As Integer
   
7.      Rr = 10
   
8.      For ii = 0 To UBound(StationArr)
   
9.         Str1 = StationArr(ii) & "<>"
   
10.         For jj = 0 To UBound(StationArr)
    
11.               Str = Str1 & StationArr(jj)
    
12.               Sheet2.Cells(Rr, 1) = Rr - 9
    
13.               Sheet2.Cells(Rr, 2) = Str
    
14.               Rr = Rr + 1
    
15.         Next jj
    
16.      Next ii
    
17.      Sheet2.Cells(1, 1) = "各站点有" & Rr - 10 & "个组合"
    
18.      Set Rng = Sheet2.Cells(20, 1).CurrentRegion
    
19.      Debug.Print Rng.Address
    
20.      
    
21.      Str = "=" & """各站点有""" & """ &  " & " & """ & Rng.Address(0, 0) & """ &  " & " & """ & "个组合" & """"
    
22.      Str = "=" & """各站点有"" & " & " Count(" & Rng.Address(0, 0) & ")" & " & " & """个组合" & """"
    
23.      Debug.Print Str
    
24.      Sheet2.Cells(1, 3) = Str
    
25. End Sub
    

复制代码

ning84

1. Sub ll()
   
2.    Dim StationArr, DistArr
   
3.    Dim Str, Str1, Dist As Integer, Dist1
   
4.    Dim Rng As Range
   
5.    StationArr = Array("陈官营", "深安大桥南", "兰州城市学院", "兰州海关", "马滩", "土门墩", "兰州西站北广场", "西站什字", "七里河", "小西湖", "文化宫", "西关", "省政府", "东方红广场", "兰州大学", "五里铺", "省气象局", "携星墩", "焦家湾", "东岗")
   
6.    DistArr = Array(0, 1579, 2340, 955, 2073, 2007, 907, 1614, 1060, 1376, 890, 1066, 969, 1456, 1426, 1293, 1303, 1163, 1116, 933)
   
7.    Dim Rr As Integer
   
8.      Rr = 10
   
9.      For ii = 0 To UBound(StationArr)
   
10.         Str1 = StationArr(ii) & "<>"
    
11.         Dist1 = DistArr(ii)
    
12.         For jj = 0 To UBound(StationArr)
    
13.               Str = Str1 & StationArr(jj)
    
14.               Dist = Abs(Dist1 - DistArr(jj))
    
15.               With Sheet2
    
16.                  .Cells(Rr, 1) = Rr - 9
    
17.                  .Cells(Rr, 2) = Str
    
18.                  .Cells(Rr, 3) = Dist
    
19.               End With
    
20.               Rr = Rr + 1
    
21.         Next jj
    
22.      Next ii
    
23.      Sheet2.Cells(1, 6) = "各站点有" & Rr - 10 & "个组合"
    
24.      Set Rng = Sheet2.Cells(20, 1).CurrentRegion
    
25.      Set Rng = Rng(, 1).Resize(Rng.Rows.Count, 1)
    
26.      Debug.Print Rng.Address
    
27.      'Str = "=" & """各站点有""" & """ &  " & " & """ & Rng.Address(0, 0) & """ &  " & " & """ & "个组合" & """"
    
28.      Str = "=" & """各站点有"" & " & " Count(" & Rng.Address(0, 0) & ")" & " & " & """个组合" & """"
    
29.      Debug.Print Str
    
30.      Sheet2.Cells(1, 2) = Str
    
31. End Sub
    

复制代码

按这个代码得出的距离结果是错误







现在要解决正确的距离
如，兰州城市学院<>兰州西站北广场的正确距离 8282

yynrzwh

直接循环呗

1. Sub ll()
   
2.    Dim StationArr, DistArr
   
3.    StationArr = Array("陈官营", "深安大桥南", "兰州城市学院", "兰州海关", "马滩", "土门墩", "兰州西站北广场", "西站什字", "七里河", "小西湖", "文化宫", "西关", "省政府", "东方红广场", "兰州大学", "五里铺", "省气象局", "携星墩", "焦家湾", "东岗")
   
4.    DistArr = Array(0, 1579, 2340, 955, 2073, 2007, 907, 1614, 1060, 1376, 890, 1066, 969, 1456, 1426, 1293, 1303, 1163, 1116, 933)
   
5.    
   
6. m = UBound(StationArr)
   
7. ReDim br(1 To 99999, 1 To 3)
   
8. For i = 0 To m - 1
   
9.     For j = i + 1 To m
   
10.         r = r + 1
    
11.         br(r, 1) = StationArr(i)
    
12.         br(r, 2) = StationArr(j)
    
13.         For x = i To j
    
14.             br(r, 3) = br(r, 3) + DistArr(x)
    
15.         Next
    
16.     Next
    
17. Next
    
18. 
    
19. Sheet1.Range("a25").Resize(r, 3) = br
    
20. End Sub

复制代码

xbox1210

如，兰州城市学院<>兰州西站北广场的正确距离 8282
这个距离似乎是不对的。

yjh_27

【已总结】[第119期]假如你是无人驾驶车上的电脑，你想好了怎么走吗？
https://club.excelhome.net/thread-1379620-1-1.html
(出处: ExcelHome技术论坛)

ning84

xbox1210 发表于 2024-8-22 11:22
如，兰州城市学院兰州西站北广场的正确距离 8282
这个距离似乎是不对的。

谢谢高手帮组，需要花很大的精力消化理解。

多做几遍题

1. Function BetweenStation(Sht As Worksheet, StationStr)
   
2.    Dim StationArr, DistArr
   
3.    Dim Str, Str1, Dist As Integer, Dist1
   
4.    Dim Rng As Range
   
5.    StationArr = Array("陈官营", "深安大桥南", "兰州城市学院", "兰州海关", "马滩", "土门墩", "兰州西站北广场", "西站什字", "七里河", "小西湖", "文化宫", "西关", "省政府", "东方红广场", "兰州大学", "五里铺", "省气象局", "携星墩", "焦家湾", "东岗")
   
6.    DistArr = Array(0, 1579, 2340, 955, 2073, 2007, 907, 1614, 1060, 1376, 890, 1066, 969, 1456, 1426, 1293, 1303, 1163, 1116, 933)
   
7.    Dim Rr As Integer, Kk
   
8.      Rr = 10
   
9.      For ii = 0 To UBound(StationArr)
   
10.            If StationStr = StationArr(ii) Then
    
11.                 Exit For
    
12.            End If
    
13.      Next ii
    
14.      
    
15.      ''
    
16.      'For ii = Kk To Kk 'UBound(StationArr)
    
17.         
    
18.         Str1 = StationArr(ii) & "→"
    
19.         Dist = 0 'DistArr(ii)
    
20.         Str = Str1 & Str1
    
21.         For jj = ii + 1 To UBound(StationArr)
    
22.               ''
    
23.               Str = Str1 & StationArr(jj)
    
24.               Dist = Dist + DistArr(jj)
    
25.               With Sht
    
26.                  .Cells(Rr, 1) = Rr - 9
    
27.                  .Cells(Rr, 2) = Str
    
28.                  .Cells(Rr, 3) = Dist
    
29.                  Select Case Dist
    
30.                       Case Is = 0
    
31.                            .Cells(Rr, 4) = "-"
    
32.                       Case Is <= 4000
    
33.                            .Cells(Rr, 4) = 2
    
34.                       Case Is <= 8000
    
35.                            .Cells(Rr, 4) = 3
    
36.                       Case Is <= 12000
    
37.                            .Cells(Rr, 4) = 4
    
38.                       Case Is <= 18000
    
39.                            .Cells(Rr, 4) = 5
    
40.                       Case Is <= 24000
    
41.                            .Cells(Rr, 4) = 6
    
42.                       Case Is <= 32000
    
43.                            .Cells(Rr, 4) = 7
    
44.                       Case Is <= 40000
    
45.                            .Cells(Rr, 4) = 8
    
46.                       Case Else
    
47.                  End Select
    
48.               End With
    
49.               Rr = Rr + 1
    
50.         Next jj
    
51.      'Next ii
    
52.      ''
    
53.      Set Rng = Sht.Cells(10, 1).CurrentRegion
    
54.      Set Rng = Rng(, 1).Resize(Rng.Rows.Count, 1)
    
55.      Debug.Print Rng.Address
    
56.      'Str = "=" & """各站点有""" & """ &  " & " & """ & Rng.Address(0, 0) & """ &  " & " & """ & "个组合" & """"
    
57.      Str = "=" & """统计共"" & " & " Count(" & Rng.Address(0, 0) & ")" & " & " & """站点" & """"
    
58.      Debug.Print Str
    
59.      Sht.Cells(1, 2) = Str
    
60. End Function
    
61. 
    
62. Sub llll()
    
63.   Dim Sht As Worksheet
    
64.   Dim Rng As Range
    
65.      Set Sht = Sheet2
    
66.      Sht.Cells.Clear
    
67.     'BetweenStation "兰州海关"
    
68.    
    
69.     'BetweenStation Sht, "西站什字"
    
70.     'BetweenStation Sht, "省政府"
    
71.     BetweenStation Sht, "陈官营"
    
72.     'BetweenStation Sht, "携星墩"
    
73. End Sub
    

复制代码

ning84

yynrzwh 发表于 2024-8-22 09:15
直接循环呗

谢谢解答，再做一遍题

1. Function delBetweenStation(Sht As Worksheet, StationStr)
   
2.    Dim StationArr, DistArr
   
3.    Dim Str, Str1, Dist As Integer, Dist1
   
4.    Dim Rng As Range
   
5.    StationArr = Array("陈官营", "深安大桥南", "兰州城市学院", "兰州海关", "马滩", "土门墩", "兰州西站北广场", "西站什字", "七里河", "小西湖", "文化宫", "西关", "省政府", "东方红广场", "兰州大学", "五里铺", "省气象局", "携星墩", "焦家湾", "东岗")
   
6.    DistArr = Array(0, 1579, 2340, 955, 2073, 2007, 907, 1614, 1060, 1376, 890, 1066, 969, 1456, 1426, 1293, 1303, 1163, 1116, 933)
   
7.    Dim Rr As Integer, Kk
   
8.      Rr = 10
   
9.      For ii = 0 To UBound(StationArr)
   
10.            If StationStr = StationArr(ii) Then
    
11.                 Exit For
    
12.            End If
    
13.      Next ii
    
14.      
    
15.      ''
    
16.      'For ii = Kk To Kk 'UBound(StationArr)
    
17.         
    
18.         Str1 = StationArr(ii) & "→"
    
19.         Dist = 0 'DistArr(ii)
    
20.         Str = Str1 & Str1
    
21.         For jj = ii + 1 To UBound(StationArr)
    
22.               ''
    
23.               Str = Str1 & StationArr(jj)
    
24.               Dist = Dist + DistArr(jj)
    
25.               With Sht
    
26.                  .Cells(Rr, 1) = Rr - 9
    
27.                  .Cells(Rr, 2) = Str
    
28.                  .Cells(Rr, 3) = Dist
    
29.                  Select Case Dist
    
30.                       Case Is = 0
    
31.                            .Cells(Rr, 4) = "-"
    
32.                       Case Is <= 4000
    
33.                            .Cells(Rr, 4) = 2
    
34.                       Case Is <= 8000
    
35.                            .Cells(Rr, 4) = 3
    
36.                       Case Is <= 12000
    
37.                            .Cells(Rr, 4) = 4
    
38.                       Case Is <= 18000
    
39.                            .Cells(Rr, 4) = 5
    
40.                       Case Is <= 24000
    
41.                            .Cells(Rr, 4) = 6
    
42.                       Case Is <= 32000
    
43.                            .Cells(Rr, 4) = 7
    
44.                       Case Is <= 40000
    
45.                            .Cells(Rr, 4) = 8
    
46.                       Case Else
    
47.                  End Select
    
48.               End With
    
49.               Rr = Rr + 1
    
50.         Next jj
    
51.      'Next ii
    
52.      ''
    
53.      Set Rng = Sht.Cells(10, 1).CurrentRegion
    
54.      Set Rng = Rng(, 1).Resize(Rng.Rows.Count, 1)
    
55.      Debug.Print Rng.Address
    
56.      'Str = "=" & """各站点有""" & """ &  " & " & """ & Rng.Address(0, 0) & """ &  " & " & """ & "个组合" & """"
    
57.      Str = "=" & """统计共"" & " & " Count(" & Rng.Address(0, 0) & ")" & " & " & """站点" & """"
    
58.      Debug.Print Str
    
59.      Sht.Cells(1, 2) = Str
    
60. End Function
    
61. 
    
62. 
    
63. Function BetweenStation(Sht As Worksheet, StationStr)
    
64.    Dim StationArr, DistArr
    
65.    Dim Str, Str1, Dist As Integer, Dist1
    
66.    Dim eastArr(), westArr()
    
67.    Dim Rng As Range
    
68.    StationArr = Array("陈官营", "深安大桥南", "兰州城市学院", "兰州海关", "马滩", "土门墩", "兰州西站北广场", "西站什字", "七里河", "小西湖", "文化宫", "西关", "省政府", "东方红广场", "兰州大学", "五里铺", "省气象局", "携星墩", "焦家湾", "东岗")
    
69.    Debug.Print UBound(StationArr)
    
70.    
    
71.    DistArr = Array(0, 1579, 2340, 955, 2073, 2007, 907, 1614, 1060, 1376, 890, 1066, 969, 1456, 1426, 1293, 1303, 1163, 1116, 933)
    
72.    Dim Rr As Integer, Kk
    
73.    Dim Arr(1)
    
74.      Rr = 0
    
75.      For ii = 0 To UBound(StationArr)
    
76.            If StationStr = StationArr(ii) Then
    
77.                 ReDim westArr(ii - 1, 3)
    
78.                 ReDim eastArr(UBound(DistArr) - ii - 1, 3)
    
79.                 Exit For
    
80.            End If
    
81.      Next ii
    
82.      
    
83.      Str1 = StationArr(ii) & "→"
    
84.      Dist = 0 'DistArr(ii)
    
85.      ''
    
86.      For jj = ii + 1 To UBound(StationArr)
    
87.               ''
    
88.               Str = Str1 & StationArr(jj)
    
89.               Dist = Dist + DistArr(jj)
    
90.               With Sht
    
91.                  eastArr(Rr, 0) = Rr + 1
    
92.                  eastArr(Rr, 1) = Str
    
93.                  eastArr(Rr, 2) = Dist
    
94.                  Select Case Dist
    
95.                       Case Is = 0
    
96.                            eastArr(Rr, 3) = "-"
    
97.                       Case Is <= 4000
    
98.                            eastArr(Rr, 3) = 2
    
99.                       Case Is <= 8000
    
100.                            eastArr(Rr, 3) = 3
     
101.                       Case Is <= 12000
     
102.                            eastArr(Rr, 3) = 4
     
103.                       Case Is <= 18000
     
104.                            eastArr(Rr, 3) = 5
     
105.                       Case Is <= 24000
     
106.                            eastArr(Rr, 3) = 6
     
107.                       Case Is <= 32000
     
108.                            eastArr(Rr, 3) = 7
     
109.                       Case Is <= 40000
     
110.                            eastArr(Rr, 3) = 8
     
111.                       Case Else
     
112.                  End Select
     
113.               End With
     
114.               Rr = Rr + 1
     
115.      Next jj
     
116.      '''
     
117.      Rr = 0
     
118.      For jj = ii - 1 To 0 Step -1
     
119.               ''
     
120.               Str = Str1 & StationArr(jj)
     
121.               Dist = Dist + DistArr(jj)
     
122.               With Sht
     
123.                  westArr(Rr, 0) = Rr + 1
     
124.                  westArr(Rr, 1) = Str
     
125.                  westArr(Rr, 2) = Dist
     
126.                  Select Case Dist
     
127.                       Case Is = 0
     
128.                            westArr(Rr, 3) = "-"
     
129.                       Case Is <= 4000
     
130.                            westArr(Rr, 3) = 2
     
131.                       Case Is <= 8000
     
132.                            westArr(Rr, 3) = 3
     
133.                       Case Is <= 12000
     
134.                            westArr(Rr, 3) = 4
     
135.                       Case Is <= 18000
     
136.                            westArr(Rr, 3) = 5
     
137.                       Case Is <= 24000
     
138.                            westArr(Rr, 3) = 6
     
139.                       Case Is <= 32000
     
140.                            westArr(Rr, 3) = 7
     
141.                       Case Is <= 40000
     
142.                            westArr(Rr, 3) = 8
     
143.                       Case Else
     
144.                  End Select
     
145.               End With
     
146.               Rr = Rr + 1
     
147.         Next jj
     
148.         Arr(0) = eastArr
     
149.         Arr(1) = westArr
     
150.         BetweenStation = Arr
     
151. End Function
     
152. 
     
153. Sub llll()
     
154.   Dim Sht As Worksheet
     
155.   Dim Rng As Range
     
156.   Dim Rr
     
157.      Rr = 10
     
158.      Set Sht = Sheet2
     
159.      Sht.Cells.Clear
     
160.     'BetweenStation "兰州海关"
     
161.    
     
162.     'BetweenStation Sht, "西站什字"
     
163.     'BetweenStation Sht, "省政府"
     
164.     'BetweenStation Sht, "陈官营"
     
165.     Arr = BetweenStation(Sht, "携星墩")
     
166.    
     
167.    
     
168.     With Sht
     
169.          .Cells(Rr - 2, 1) = "陈官营方向" & UBound(Arr(0)) + 1 & "个站点"
     
170.          .Cells(Rr, 1).Resize(UBound(Arr(0)) + 1, 4) = Arr(0)
     
171.          .Cells(Rr - 2, 6) = "东岗方向" & UBound(Arr(1)) + 1 & "个站点"
     
172.          .Cells(Rr, 6).Resize(UBound(Arr(1)) + 1, 4) = Arr(1)
     
173.     End With
     
174. End Sub
     

复制代码

现在的问题是从陈官营出发遇到的问题是

ii=0时     ii - 1不成立。
For ii = 0 To UBound(StationArr)
           If StationStr = StationArr(ii) Then
                ReDim westArr(ii - 1, 3)
                ReDim eastArr(UBound(DistArr) - ii - 1, 3)
                Exit For
           End If
     Next ii