|
楼主 |
发表于 2024-10-15 17:23
|
显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
学习学习,再学习。
- Function RegTimeKm(Rng As Range)
- Dim Str
- Str = Rng(, 2)
- Dim Arr(2)
- Dim MatColl As MatchCollection
- Dim TimeReg As New RegExp
- TimeReg.Pattern = "\d{2}:\d{2}"
- Set MatColl = TimeReg.Execute(Str)
- Arr(0) = MatColl.Item(0)
- Dim KmReg As New RegExp
- Dim oVal As Validation
- KmReg.Pattern = "\d+\.\d+米|\d+\.\d+千米|\d+千米|\d+米"
- Set MatColl = KmReg.Execute(Replace(Str, " ", ""))
- 'Stop
- Str = MatColl.Item(0)
-
- Arr(1) = MatColl.Item(0)
- RegTimeKm = Arr
- Dim Reg As New RegExp
- Str = Rng(, 1)
-
- Reg.Pattern = "^\d?s千米"
- Reg.Pattern = "\D+"
- Set MatColl = Reg.Execute(Replace(Str, " ", ""))
- 'Stop
- Str = MatColl.Item(0)
- Arr(2) = Str
- RegTimeKm = Arr
-
- End Function
- Sub ll()
- Dim oDate As Date, oDate1 As Date
- Dim Rng As Range, Arr, Bus
- With Sheets("Tmp")
- Set Rng = .Cells(5, 1).CurrentRegion
- oDate1 = .Cells(1, 1)
- Bus = .Cells(1, 2)
-
- End With
- Dim K9Road
-
- K9Road = K9RoadArr
-
- Dim Sht As Worksheet
- Set Sht = Sheets("K9")
-
- With Sht
- .Activate
- .Cells.Clear
- .Cells.Font.Size = 9
- End With
- Dim ii, Cc, Rr
- Rr = 10
- Cc = 5
- For ii = 1 To Rng.Rows.Count
- Arr = RegTimeKm(Rng(ii, 1))
- With Sht
-
- .Cells(Rr + ii, Cc) = Arr(2)
- .Cells(Rr + ii, Cc + 1) = K9Road(1)(Rng.Rows.Count - ii + 0)
- .Cells(Rr + ii, Cc + 2) = Format(oDate1, "yyyy年mm月dd日") & " " & Arr(0)
- .Cells(Rr + ii, Cc + 3) = Arr(0)
- .Cells(Rr + ii, Cc + 4) = Arr(1)
- ''
- .Cells(Rr + ii, 1) = ii
- .Cells(Rr + ii, 2) = Bus & "," & Format(oDate1, "yyyy年mm月dd日") & Arr(0) & "行驶到" & K9Road(1)(Rng.Rows.Count - ii + 0) & "--" & Arr(2) & "的公交站"
-
-
-
- End With
- Next ii
- End Sub
复制代码
- Function K9RoadArr()
- Dim StationArr, RoadArr
- StationArr = Array("香洲", "南坑", "南香里", "香宁花园", "柠溪", "隧道南", "兰埔(富华里)", "白石(银石雅园)", "华发新城", "翠湾", "湖心路口", "保利香槟", "时代山湖海", "二号闸", "金湾高尔夫", "青湾", "东咀", "金岛路东", "金都大厦", "金海岸中学", "金沙湾豪庭", "斜尾", "城建总公司", "鱼弄", "中南修理厂", "月堂", "唐人街", "映月新村", "三灶车场")
- RoadArr = Array("紫荆路", "紫荆路", "柠溪路", "柠溪路", "柠溪路", "迎宾南路", "九洲大道西(S366)", "九洲大道西(S366)", "九洲大道西(S366)", "九洲大道西(S366)", "九洲大道西(S366)", "金湾路(S272)", "金湾路(S272)", "金湾路(S272)", "金湾路(S272)", "金湾路(S272)", "金岛路", "金岛路", "金岛路", "金岛路", "金岛路", "金岛路", "金海岸大道东", "金海岸大道东", "金海岸大道西", "金海岸大道西", "伟民路", "映月路", "琴石路")
- Dim Arr(1)
- Arr(0) = StationArr
- Arr(1) = RoadArr
- K9RoadArr = Arr
- End Function
复制代码
|
|