½Ð±Ð¦U¦ì«e½úvba Ãö©ó³æ¤@Àx¦s®æ¦¡¤º²Îp°ÝÃD~
- ©«¤l
- 43
- ¥DÃD
- 13
- ºëµØ
- 0
- ¿n¤À
- 75
- ÂI¦W
- 0
- §@·~¨t²Î
- windows 7
- ³nÅ骩¥»
- office 2007
- ¾\ŪÅv
- 20
- µù¥U®É¶¡
- 2014-5-6
- ³Ì«áµn¿ý
- 2019-6-17
|
½Ð±Ð¦U¦ì«e½úvba Ãö©ó³æ¤@Àx¦s®æ¦¡¤º²Îp°ÝÃD~
½Ð°Ý¦U¦ì¤j¤j¦]¤p§Ì©Ò¸I¨ì¸ê®Æ«¬ºA¦p¤U¡B«o¤]»Ý¶i¦æ²Îp¡A½Ð°Ý¦¹ºØ¸ê®Æ§ÎºA¨Ï¥Îvba¦³¿ëªk²Îp¶Ü¡H
¤£¦n·N«ä¦]¦¹ºØ³æ¤@Àx¦s®æ¶i¦æ²Îp¡B¤p§Ì¤£ª¾¹D¦p¦óµÛ¤â¶i¦æ..©Ò¥H½Ð³Â·Ð¦U¦ì¤j¤j¤F¡C
ªþ¥ó»¡©ú¦p¤U¡G
1. A & B Ä欰¸ê®ÆDATA²M³æ
2.¥Dn°ÝÃD¬°BÄæ©Ò¨Ï¥Îªº¬OKEY in ¦b¤@°_ªº¸ê®Æ§ÎºA¡A¨Ò"B2" = 20-Ä«ªG («öENTER¦Ü¦P¤@®æ¤U¤èÄòKEY in) 50-»¿¼ ¡A
¨Ã¥B¥X²{ªº¶µ¥Ø¤£¤@©w¡B¥uª¾¹D³æ¤@Àx¦s®æ¦¡¬° ¨Ò"B6"¡G ( ¼Æ¶q -¶µ¥Ø ) or ( ¼Æ¶q -¶µ¥Ø +enter ¼Æ¶q -¶µ¥Ø)
3.¦p¥i¶i¦æ²Îp¡B½Ð°Ýn«ç»ò¹³"F:H"Ä污ªp¦C¥X¦p¦¹ºØªº²Îp²M³æ¥X¨Ó©O¡H(ªþ¥ó¤º®e"F:H"¬°¥Î¤âkey in¤W¥h..)
·PÁÂ~ |
|
|
|
|
|
|
- ©«¤l
- 1018
- ¥DÃD
- 15
- ºëµØ
- 0
- ¿n¤À
- 1058
- ÂI¦W
- 0
- §@·~¨t²Î
- win7 32bit
- ³nÅ骩¥»
- Office 2016 64-bit
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ®ç¶é
- µù¥U®É¶¡
- 2012-5-9
- ³Ì«áµn¿ý
- 2022-9-28
|
¥»©«³Ì«á¥Ñ stillfish00 ©ó 2014-5-26 19:59 ½s¿è
¦^´_ 1# ii31sakura
¶È¨Ñ°Ñ¦Ò
³Ì¦nªº°µªkÁÙ¬O¤@¶}©lªºªí®æ´N¥ý©w¸q©ú½T¡A³æ¤@Àx¦s®æ¤£n¦h¥Î³~¡C- Sub Test()
- Dim d, i As Long, dteDate As Date, lValue As Long, sType As String
- Dim oReg, oMatch, x, y, lCnt As Long, ar
-
- Set d = CreateObject("scripting.dictionary")
- Set oReg = CreateObject("vbscript.regexp")
- With oReg
- .Global = True
- .Pattern = "(\d+)-(\S+)"
- End With
-
- 'Analyze
- With Sheets("Sheet1").[A1].CurrentRegion
- If .Rows.Count < 2 Then Exit Sub
- For i = 2 To .Rows.Count
- dteDate = .Cells(i, 1).Value
- 'make 2 levels dictionary
- If Not d.exists(dteDate) Then Set d(dteDate) = CreateObject("scripting.dictionary")
-
- Set oMatch = oReg.Execute(.Cells(i, 2).Value)
- For Each x In oMatch
- lValue = CLng(oReg.Replace(x.Value, "$1"))
- sType = oReg.Replace(x.Value, "$2")
- With d(dteDate)
- If .exists(sType) Then
- .Item(sType) = .Item(sType) + lValue
- Else
- .Item(sType) = lValue
- lCnt = lCnt + 1
- End If
- End With
- Next
- Next
- End With
-
- 'Read to array
- ReDim ar(1 To lCnt, 1 To 3)
- i = 0
- For Each x In d.keys
- For Each y In d(x).keys
- i = i + 1
- ar(i, 1) = x
- ar(i, 2) = y
- ar(i, 3) = d(x)(y)
- Next
- Next
- 'Fill into worksheet
- With Sheets("Sheet1").[F1]
- .Resize(1, 3).Value = Array("¤é´Á", "¨ä¥¦¶µ¥Ø", "¨ä¥¦Á`¼Æ¶q(Áû²É¼Æ)")
- .Offset(1).Resize(lCnt, 3).Value = ar
- End With
- End Sub
½Æ»s¥N½X |
|
|
|
|
|
|
- ©«¤l
- 43
- ¥DÃD
- 13
- ºëµØ
- 0
- ¿n¤À
- 75
- ÂI¦W
- 0
- §@·~¨t²Î
- windows 7
- ³nÅ骩¥»
- office 2007
- ¾\ŪÅv
- 20
- µù¥U®É¶¡
- 2014-5-6
- ³Ì«áµn¿ý
- 2019-6-17
|
¦^´_ 2# stillfish00
stillfish00¤j¤j»¡ªº¨S¿ù¡B³Ì¦nªº¤èªk¬O³æ¤@Àx¦s®æ³æ¥Î³~¡A
¥u¬O¦]¤p§Ì¸I¨ìªº¬O¹³¦¹ºØÃþ«¬ªºkey in¤è¦¡¥B®æ¦¡¥Ø«e¥u¯àÂê©w¦¹ºØkeyªk¦ý¤S»Ý¥h²Îp¸Ì±¦³¤°»ò¡B©Ò¥H«Ü·PÁÂstillfish00¤j¤jªºÀ°¦£®@~ |
|
|
|
|
|
|
- ©«¤l
- 4901
- ¥DÃD
- 44
- ºëµØ
- 24
- ¿n¤À
- 4916
- ÂI¦W
- 240
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Office 20xx
- ¾\ŪÅv
- 150
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥x¥_
- µù¥U®É¶¡
- 2010-4-30
- ³Ì«áµn¿ý
- 2024-11-6
|
¦^´_ 1# ii31sakura - Sub ex()
- Set d = CreateObject("Scripting.Dictionary")
- For Each a In Range([A2], [A2].End(xlDown)) '¨C¤é
- ar = Split(a.Offset(, 1), Chr(10)) '´«¦æ¸ê®Æ
- For Each k In ar
- s = Split(k, "-")(0): p = Split(k, "-")(1) '¨ú±o¼Æ¶q»P«~¦W
- If IsEmpty(d(a & p)) Then '¼g¤J¦r¨å
- d(a & p) = Array(a.Value, p, Val(s))
- Else
- d(a & p) = Array(a.Value, p, d(a & p)(2) + Val(s))
- End If
- Next
- Next
- [F2].Resize(d.Count, 3) = Application.Transpose(Application.Transpose(d.items)) '¼g¤J¤u§@ªí
- End Sub
½Æ»s¥N½X |
|
¾Ç®üµL²P_¤£®¢¤U°Ý
|
|
|
|
|
- ©«¤l
- 2035
- ¥DÃD
- 24
- ºëµØ
- 0
- ¿n¤À
- 2031
- ÂI¦W
- 0
- §@·~¨t²Î
- Win7
- ³nÅ骩¥»
- Office2010
- ¾\ŪÅv
- 100
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2012-3-22
- ³Ì«áµn¿ý
- 2024-2-1
|
¦^´_ 4# Hsieh
«Ü¤£¿ùªº "Scripting.Dictionary" À³¥Î¡A
ÁÂÁ±z«ü¾É¡I |
|
|
|
|
|
|
- ©«¤l
- 43
- ¥DÃD
- 13
- ºëµØ
- 0
- ¿n¤À
- 75
- ÂI¦W
- 0
- §@·~¨t²Î
- windows 7
- ³nÅ骩¥»
- office 2007
- ¾\ŪÅv
- 20
- µù¥U®É¶¡
- 2014-5-6
- ³Ì«áµn¿ý
- 2019-6-17
|
¦^´_ 4# Hsieh
«Ü·PÁÂHsieh¤j¤j´£¨Ñªº¥t¤@ºØ¤èªk¡BÅý¤p§Ì¥i¥H¾Ç¨ì§ó¦h¡A·PÁ¤j®aªºÀ°¦£®@~ |
|
|
|
|
|
|
- ©«¤l
- 1446
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1470
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-10-21
|
ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð«e½úÌ«ü±Ð
°õ¦æ«e:
°õ¦æµ²ªG:
Option Explicit
Sub TEST()
Dim Brr, Crr(1 To 100, 1 To 3), Y, Z, R&, R1&, i&, j&
Dim xR As Range, TT$, T1$, B$, A$
Set Y = CreateObject("Scripting.Dictionary")
Set xR = Range([B1], Cells(Rows.Count, "A").End(3)): Brr = xR
For i = 2 To UBound(Brr)
If i = 2 Then R = 1: Crr(R, 1) = "¤é´Á": Crr(R, 2) = "¶µ¥Ø": Crr(R, 3) = "Á`¼Æ"
Z = Split(Brr(i, 2), vbLf): T1 = Brr(i, 1)
For j = 0 To UBound(Z)
A = Split(Z(j), "-")(0): B = Split(Z(j), "-")(1): TT = T1 & "|" & B
If Y(TT) = "" Then
R = R + 1: R1 = R: Y(TT) = R1
Crr(R1, 1) = Brr(i, 1): Crr(R1, 2) = B
Else
R1 = Y(TT)
End If
Crr(R1, 3) = Crr(R1, 3) + Val(A)
Next
Next
With [J1].Resize(R, 3)
.EntireColumn.ClearContents
.Value = Crr
.Sort KEY1:=.Item(1), Order1:=1, _
Key2:=.Item(2), Order2:=1, Header:=1
End With
Set Y = Nothing: Set xR = Nothing: Erase Brr, Crr, Z
End Sub |
|
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y
|
|
|
|
|