把每个药方中的每种药材，按数量的多少，重新先后排序

相见是缘8 · 发表于 2024-7-13 13:02

snow653124 发表于 2024-7-13 06:26
我可不是老师我是为了自己工作轻松自己摸索的完全野路子
平时接触较多的是排版
这个东西，我知道涉 ...

snow653124 老师好！
比我懂的就是老师！期待老师的代码！

相见是缘8 · 发表于 2024-7-13 13:03

batmanbbs 发表于 2024-7-13 08:21
想简单了，看看sylun老师的代码就知道，根据楼主的示例，至少还需要增加如下内容：
（1）这个数组至少包 ...

batmanbbs 老师好！
本以为比 sylun 老师编写代码的那个帖子要简单，或那位老师能把 sylun 老师的代码修改一下，就可以，没想到会有这么复杂！

batmanbbs 老师，如把它改为2～3个代码，可否实现？

相见是缘8 · 发表于 2024-7-13 13:04

snow653124 发表于 2024-7-13 10:46
确实是复杂
他这个组成：后，确实没太大规律。看一行一个规律，我还卡在正则匹配上
其他的也是写一步， ...

snow653124 老师好！
如太复杂，分成2～3个代码，也可。

过客fppt · 发表于 2024-7-13 21:16

难度太大了，我只弄了第一种示例的情况，并且不完善，只能输出s的内容：

过客fppt · 发表于 2024-7-13 21:17

过客fppt 发表于 2024-7-13 21:16
难度太大了，我只弄了第一种示例的情况，并且不完善，只能输出s的内容：

Sub 药材按升斤排序()
Dim arr, crr(), drr, err
Dim i%, j%, k%, l%, index%, ShuJC%
Dim str As String, s As String
Dim brr() As String, ShuJurr
str = "组成：附子（熟）10克、干姜6克、鸡子黄1个、花椒子13粒（捣碎）。人参6克、白术（炙）10克、茯苓10克、陈皮6克、甘草（炙）6克、五味子3克、半夏（洗，去滑）10克、生姜3片、红枣4枚（切开）。"
arr = Split("克、枚、段、片、粒、个", "、")
str = Replace(str, "组成：", "")
str = Left(str, Len(str) - 1)
str = Replace(str, "。", "、")
brr = Split(str, "、")
ReDim drr(LBound(brr) To UBound(brr))
ReDim crr(LBound(brr) To UBound(brr), 1 To 3) '表格
'正则表达式
Dim reg As Object
Dim Ma
Set reg = CreateObject("VBScript.RegExp")
For i = LBound(brr) To UBound(brr)
With reg
.Global = False
.IgnoreCase = True '不区分大小写
.Pattern = "\d{1,}" '正则表达式
Set Ma = .Execute(brr(i)) '返回在文本中匹配的集合
'拆分为表格
crr(i, 1) = Left(brr(i), Ma(0).firstindex)
crr(i, 2) = mid(brr(i), Ma(0).firstindex + 1, Ma(0).Length)
crr(i, 3) = Right(brr(i), Len(brr(i)) - Ma(0).Length - Ma(0).firstindex)
End With
Next i
二维数组排序3 crr, 2
i = 0
'重新组合
ReDim ShuJurr(LBound(crr) To UBound(crr))
For i = LBound(crr) To UBound(crr)
ShuJurr(i) = crr(i, 1) & crr(i, 2) & crr(i, 3)
Next
'"克、枚、段、片、粒、个"排序
For i = LBound(arr) To UBound(arr)
For j = LBound(ShuJurr) To UBound(ShuJurr)
If InStr(ShuJurr(j), arr(i)) Then
drr(k) = ShuJurr(j)
k = k + 1
End If
Next
Next
'文字输出
For i = LBound(drr) To UBound(drr)
s = s & drr(i) & "、"
Next
End Sub
Sub 二维数组排序3(ByRef arr() As Variant, WeiDu As Integer)
Dim numRows As Integer, i As Integer, j As Integer, k As Integer
Dim s As Single, s1 As Single
numRows = UBound(arr) - LBound(arr) + 1
Dim temp()
ReDim temp(LBound(arr, 2) To UBound(arr, 2))
For i = 0 To numRows - 1
For j = 0 To numRows - 2
s = arr(j, WeiDu)
s1 = arr(j + 1, WeiDu)
If s > s1 Then
' 交换位置
For k = LBound(arr, 2) To UBound(arr, 2)
temp(k) = arr(j, k)
arr(j, k) = arr(j + 1, k)
arr(j + 1, k) = temp(k)
Next
End If
Next j
Next i
End Sub

复制代码

过客fppt · 发表于 2024-7-13 21:56

过客fppt 发表于 2024-7-13 21:16
难度太大了，我只弄了第一种示例的情况，并且不完善，只能输出s的内容：

我目前已经实现了数量的排序以及自定义的排序，第一种的处理还好，可以用正则找出数据的位置把这些内容分解为一个表格，对数量那一列进行一个冒泡排序，但是第二种情况里面根本就不是阿拉伯数据，会使得处理更加复杂，就算了吧。
至于最后要输出各10克之类的，楼主可以自己加代码处理一下

相见是缘8 · 发表于 2024-7-14 05:39

过客fppt 发表于 2024-7-13 21:56
我目前已经实现了数量的排序以及自定义的排序，第一种的处理还好，可以用正则找出数据的位置把这些内容分 ...

过客 fppt 老师好！
感谢老师援手！代码在我这附件上运行后，附件上的内容好像没啥改动。

batmanbbs · 发表于 2024-7-14 08:27

相见是缘8 发表于 2024-7-14 05:39
过客 fppt 老师好！
感谢老师援手！代码在我这附件上运行后，附件上的内容好像没啥改动。

既然自己有这么多需求，有空还是自己学学VBA，求人不如求己。
恕我直言，有空整理药典，挤出时间自学一下VBA吧，在论坛泡这么多年，不会写也至少能看懂别人提供的代码了。

过客fppt · 发表于 2024-7-14 09:30

相见是缘8 发表于 2024-7-14 05:39
过客 fppt 老师好！
感谢老师援手！代码在我这附件上运行后，附件上的内容好像没啥改动。

因为我是直接在论坛上复制你的示例1写的，直接用变量str = "组成：附子（熟）10克、干姜6克、鸡子黄1个、花椒子13粒（捣碎）。人参6克、白术（炙）10克、茯苓10克、陈皮6克、甘草（炙）6克、五味子3克、半夏（洗，去滑）10克、生姜3片、红枣4枚（切开）。"
针对这段内容写出核心的处理代码，但是并没有弄到文档中，建议你遍历段落，str=段落的文本即可

相见是缘8 · 发表于 2024-7-15 06:25

batmanbbs 发表于 2024-7-14 08:27
既然自己有这么多需求，有空还是自己学学VBA，求人不如求己。
恕我直言，有空整理药典，挤出时间自学一 ...

batmanbbs 老师好！
感谢直言！
我对这个VBA是“又爱又恨”，爱的是，它几秒钟就可解决你要几天顺至几个月时间做的事，恨的是，我怎么也学不进去，也可能是没这方面的天赋，也可能是兴趣不够，反正见它就头大，追根究底可能还是时间不够，像我这种打工的，白天肯定是没时间，就晚上几个小时（还经常要加班），要做的事很多，你说我借口也罢，懒也罢，实践就这么个情况，以前刚开始想学，后来发现太难了，也不是短时间能学会的，故放弃了，如我是在体制内上班的，肯定会认真深学这个东西，因它有的是时间，且无压力。
batmanbbs 老师，我也知道求人难，老话说：求人如行乞！求人如吞三尺剑！因这全凭别人愿不愿意，碰到修养好的老师还好，碰到修养不好的老师，难免心理难受（这让我想起前几年139朋友的一次发飚回复， https://club.excelhome.net/thread-1406961-2-1.html 14楼），这也没办法，人不可能面面俱到，自己不会的东西总要求人，只能自己调整心态！

		自动登录	找回密码
密码			免费注册

[求助] 把每个药方中的每种药材，按数量的多少，重新先后排序

评分