- ©«¤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¨å,¥Î¦r¨å°O¿ýÄ渹»P¦C¸¹ªº¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
°õ¦æ«e:
°õ¦æµ²ªG:
Option Explicit
Sub TEST_A()
Dim ¸ê®Æ°}¦C, ªÅ°}¦C, ¦r¨å, i&, j%, ¦r¦ê¤À³Î¤@ºû°}¦C, °ÑÁɱo¼úªÌ, ¦W¦¸%
Dim ªÅ°}¦CÄ渹%, ªÅ°}¦C¦C¸¹&, °ÑÁɱo¼ú¤H¼Æ%, ¦W¦¸¼Æ&, °ÑÁɱo¼ú¤H¦¸&
Set ¦r¨å = CreateObject("Scripting.Dictionary")
¸ê®Æ°}¦C = Range([B2], [A65536].End(xlUp))
ReDim ªÅ°}¦C(1000, 1000)
For i = 1 To UBound(¸ê®Æ°}¦C)
¦W¦¸ = Val(¸ê®Æ°}¦C(i, 2))
ªÅ°}¦C¦C¸¹ = ¦r¨å(¦W¦¸)
If ªÅ°}¦C¦C¸¹ = 0 Then
¦W¦¸¼Æ = ¦W¦¸¼Æ + 1
ªÅ°}¦C¦C¸¹ = ¦W¦¸¼Æ
¦r¨å(¦W¦¸) = ªÅ°}¦C¦C¸¹
ªÅ°}¦C(ªÅ°}¦C¦C¸¹, 0) = ¦W¦¸
End If
¦r¦ê¤À³Î¤@ºû°}¦C = Split(¸ê®Æ°}¦C(i, 1) & " ", " ")
For Each °ÑÁɱo¼úªÌ In ¦r¦ê¤À³Î¤@ºû°}¦C
If °ÑÁɱo¼úªÌ = "" Then GoTo i01
ªÅ°}¦CÄ渹 = ¦r¨å(°ÑÁɱo¼úªÌ)
If ªÅ°}¦CÄ渹 = 0 Then
°ÑÁɱo¼ú¤H¼Æ = °ÑÁɱo¼ú¤H¼Æ + 1
ªÅ°}¦CÄ渹 = °ÑÁɱo¼ú¤H¼Æ
¦r¨å(°ÑÁɱo¼úªÌ) = ªÅ°}¦CÄ渹
ªÅ°}¦C(0, ªÅ°}¦CÄ渹) = °ÑÁɱo¼úªÌ
End If
ªÅ°}¦C(ªÅ°}¦C¦C¸¹, ªÅ°}¦CÄ渹) = ªÅ°}¦C(ªÅ°}¦C¦C¸¹, ªÅ°}¦CÄ渹) + 1
°ÑÁɱo¼ú¤H¦¸ = °ÑÁɱo¼ú¤H¦¸ + 1
i01: Next
Next
With [E4].Resize(¦W¦¸¼Æ + 1, °ÑÁɱo¼ú¤H¼Æ + 1)
.Value = ªÅ°}¦C
.Item(1) = "¦W¦¸\°ÑÁɱo¼úªÌ"
.Borders.LineStyle = xlContinuous
.EntireColumn.AutoFit
End With
MsgBox "°ÑÁɱo¼ú¤H¼Æ " & °ÑÁɱo¼ú¤H¼Æ & " ¤H , °ÑÁɱo¼ú¤H¦¸ " & °ÑÁɱo¼ú¤H¦¸ & " ¤H¦¸"
End Sub |
|