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

tcdatongye

ming0018 发表于 2024-7-16 09:04
您把所有情况都总结一下，基于各位同仁都是免费给您写的代码，不想一次又一次的改代码了，时间和精力都是 ...

同感。一般代码只是根据提供内容和结果格式编写，后再加就扰乱思路，有时甚至重新构思。代码运行看见过程，实际上是浪费时间的。

tcdatongye

看了下，如果尾部保留字符均在两个句号之间，则可应用。否则出现不可预测后果。
Sub 宏1()
  Dim arr(1 To 2, 1 To 1000)
  nub = 1000
  Set dic = VBA.CreateObject("scripting.dictionary")
  Set reg = VBA.CreateObject("vbscript.regexp")
  a = VBA.Split("克、枚、段、片、粒、个", "、")
    Selection.StartOf wdStory
    With Selection.Find
        .Text = "组成：*^13"
        .Forward = True
        .MatchWildcards = True
        Do While .Execute
          .Parent.MoveStart , 3
          .Parent.MoveEnd , -1
          For i = 0 To UBound(a)
            dic(a(i)) = arr
          Next i
           With reg
             .Global = True
             .Pattern = ".*。(\D+。$)"
            尾符 = IIf(.test(Selection), .Replace(Selection, "$1"), "")
             .Pattern = "[^、。]*?(\d+)([克枚段片粒个])[^、。]*"
             Set jj = .Execute(Selection)
             If jj.Count = 0 Then GoTo 10
            For Each kk In jj
             temp = dic(kk.submatches(1)) '取出数组
             temp(1, kk.submatches(0)) = temp(1, kk.submatches(0)) & kk & "、" '给数组赋值
             temp(2, kk.submatches(0)) = temp(2, kk.submatches(0)) + 1 '统计合并数
             dic(kk.submatches(1)) = temp '新值的数组放进去
            Next kk
            For Each s In a
              For j = nub To 1 Step -1
                If dic(s)(1, j) <> "" Then
                  If dic(s)(2, j) > 1 Then '重复次数
                    .Pattern = "\d+" & s & "|、$"
                    t = .Replace(dic(s)(1, j), "")
                     y = y & .Replace(dic(s)(1, j), "") & "，各" & j & s & "、"
                     Else
                     y = y & dic(s)(1, j)
                  End If
                End If
              Next j
            Next
          End With
          Selection = Left(y, Len(y) - 1) & "。" & 尾符
10:
          y = ""
          Selection.Move
        Loop
    End With
   
End Sub

相见是缘8

tcdatongye 发表于 2024-7-16 12:15
看了下，如果尾部保留字符均在两个句号之间，则可应用。否则出现不可预测后果。
Sub 宏1()
  Dim arr(1 T ...

Tcdatongye 老师好！
真心感谢！数字药量排序代码完美达愿！
真是会者不难，难者不会！这么麻烦难缠的流程，老师信手拈来，真让人佩服！
如老师有时间，期待你再帮忙解决中文数字的药量排序！拜谢！

相见是缘8

ming0018 发表于 2024-7-16 09:04
您把所有情况都总结一下，基于各位同仁都是免费给您写的代码，不想一次又一次的改代码了，时间和精力都是 ...

ming0018 老师好！
我发帖开始的要求及提供的附件，并未有任何改动，求老师修改代码，是代码与原要求之间有出入，这不能算是我挤牙膏、挤面条吧？

过客fppt

相见是缘8 发表于 2024-7-17 06:40
ming0018 老师好！
我发帖开始的要求及提供的附件，并未有任何改动，求老师修改代码，是代码与原要求之 ...

说实话，爹会娘会不如自己会，求人不如求己。花个把月学一下基础吧，能看懂代码就可以简单改动调整了，现在还有AI，还可以让他给你逐行解析，比以前好学多了

batmanbbs

相见是缘8 发表于 2024-7-17 06:40
ming0018 老师好！
我发帖开始的要求及提供的附件，并未有任何改动，求老师修改代码，是代码与原要求之 ...

按照你自己在一楼提出的要求，只有两种内容转换而已，tcdatongye老师第一次的代码已经实现其一，本就无需修改。但你提供示例部分又有其他形式（还不知道你正式文档中是否会有更多的情况），结果tcdatongye老师还是再次修改了代码，你说这算不算挤牙膏呢？！如果正式文档类似sylun老师代码的那贴，那么上面所有老师的代码都会有问题，这个和各位老师无关，而是你提供示例的问题。（BTW：sylun老师真的很厉害）

PS：中文剂量排序需要换算，你的换算要求一点都没有说明。可能我说的有点武断，谁写都要根据你事后的新要求进行多次修改（就ZL老师的代码来说，就算没有你说的两个问题，换算的方法我觉得也要重新调整）

另，我觉得你这个需求应该付费提出。

相见是缘8

batmanbbs 发表于 2024-7-17 11:41
按照你自己在一楼提出的要求，只有两种内容转换而已，tcdatongye老师第一次的代码已经实现其一，本就无需 ...

batmanbbs 老师好！
你可能误会了，我在一楼提出的要求，例如……
并不是指全部需求，只是为了节省篇幅，举例而已，所以才还另提供了“附件”，当然是以“附件”为淮。
关于中文剂量排序的说明，我在一楼提出的要求中，有：
每个药方中的每种药材，按数量的多少，重新先后排序，数量相同的药材，只保留最后一种药材的数量，并在前面加上，各。
替换后：（按“升、斤、两、钱、分、厘、枚、段、片、粒、个”，先后进行排序）。

相见是缘8

过客fppt 发表于 2024-7-17 09:08
说实话，爹会娘会不如自己会，求人不如求己。花个把月学一下基础吧，能看懂代码就可以简单改动调整了，现 ...

过客 fppt 老师好！
请参看我 20 楼给 batmanbbs 老师的回复！

过客fppt

相见是缘8 发表于 2024-7-17 15:43
过客 fppt 老师好！
请参看我 20 楼给 batmanbbs 老师的回复！

好吧，我2022年开始学的VBA，当时在B站跟着孙兴华老师的视频学的，你也可以跟着抽空学一学；时间的话，是挤出来的，以前晚上下班9点半回到，一样学两小时再睡，当然我也不在体制内

tcdatongye

相见是缘8 发表于 2024-7-17 06:29
Tcdatongye 老师好！
真心感谢！数字药量排序代码完美达愿！
真是会者不难，难者不会！这么麻烦难缠的 ...

zhanglei1371已帮你做了中文数字药量排序。

数词+量词为标准计量方式。而一斤半、钱半就是非标准剂量方式，像这样的非标准汉字计量方式（如一斤三之类）还有哪些？怎样换算成标准计量方式？这就是你需提供的，否则别人就是做也是无用功。如果仅此两种，相对来说计量还是比较简单的。