½Ð°Ý¦p¦ó­pºâ¥[Á`¥X¤H¦W+¼Æ¦r=¼Æ¦rÁ`¦X

ªü¦t­ô

¤U¸ü (14.07 KB)

2022-11-1 15:27

hcm19522

https://blog.xuite.net/hcm19522/twblog/590607225

Andy2483

¦^´_ 1# ªü¦t­ô

ÁÂÁ«e½úµoªí¦¹¥DÃD
«á¾ÇÂǦ¹ÃD½m²ßVBA_°}¦C»P¦r¨å!
¤£ª¾¹D¬O§_·|¿ùÃD·N?
½d¨Ò½Ð¸Õ¸Õ¬Ý!
20221102_4.zip (52.15 KB)

¤U¸ü¦¸¼Æ: 8

2022-11-2 09:21

°õ¦æ«e:

¤U¸ü (350.53 KB)

2022-11-2 09:21

°õ¦æµ²ªG:

¤U¸ü (357.74 KB)

2022-11-2 09:22

Option Explicit
Sub ¦r¨å»P°}¦C½m²ß()
Dim Brr, Crr, c&, i&, x&, xR, Y, U, ERR&
Set Y = CreateObject("Scripting.Dictionary")
Brr = Range([¾Þ§@ªí!B2], [¾Þ§@ªí!B65536].End(3))
For i = 1 To UBound(Brr)
   If Trim(Brr(i, 1)) = "" Then ERR = 1: GoTo 111
   Crr = Split(Trim(Brr(i, 1)), " ")
   U = Trim(Crr(0)) & Y(Trim(Crr(0)) & i)
   Crr = Split(Replace((Brr(i, 1)), " ", ""), U)
   If UBound(Crr) <= 1 Then ERR = 1: GoTo 111
   For x = UBound(Crr) To 2 Step -1
      If IsNumeric(Trim(Crr(x))) = False Then
         ERR = 1: GoTo 111
      End If
      Y(U & i) = Y(U & i) + Val(Trim(Crr(x)))
   Next
Next

111
If ERR = 1 Then
   Cells(i + 1, 2).Activate
   ActiveCell.Interior.ColorIndex = 38
   MsgBox "½ÐÀˬd¸ê®Æ!"
   Exit Sub
End If
[C2].Resize(Y.Count, 1) = Application.Transpose(Y.ITEMS)
End Sub