ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] vbaªº¿z¿ï¥\¯à (¨ú®ø³¡¤À¿z¿ï)

¦^´_ 29# wei9133

³Ó²v­pºâ¬O§_¬°¨S¦³­«½Æªº´N¤£¦h¥[1³õ¶Ü??
¦]¬°§Aªº³Ó³õºâªk³£¤£¤@¼Ë
¥H§A¦b#30¼Óªº¶K¹Ï
¤HÃþ4³õ³Ó²v¬°(1,2,ªÅ,ªÅ),³Ó²vÀ³¬°1+2+1+1=5«O¯d¦A¥[1,©Ò¥H¬°6
¦ý¤O¶q­^¶¯2³õ³Ó²v¬°(ªÅ,3),³Ó²vÀ³¬°1+3=4«O¯d¦A¥[1,©Ò¥H¬°5,¦ýµ¹ªº¥¿½T³Ó²v«o¬°3

(#23¼Ó:¦Ó³Ó³õ³¡¥÷ªº­È«h¤À§O¬°3¡BªÅ®æ¡B1¡A±Ñ³õªº­È«h¬°1¡BªÅ®æ¡BªÅ®æ
  ºâ¥X¨Ó¦X¨Öªº³Ó³õÄæ¦ìÀ³¬°"6"¡A±Ñ³õ«h¬°"1"
   ºâªk¬O³o¼Ëªº¡A°²³]3¨º®æ«O¯d¡A¦ÓªÅ®æ¥Nªí³Ó1³õ¡A³Ó³õ¶ñ¤J1ªº¹ê»Ú¤W¬O"·í¦C"¥["³Ó1³õ"
   ©Ò¥H¥[¥X¨Ó¬O"6")
³Ó³õ(3,ªÅ,1)=6,¦pªG¥HªÅ¬°1,¹ê»Ú¤]¬O5,¦hªº1³õ¤£´N¬O¦Ó¥~¼W¥[ªº¶Ü??

¥t¥~¸ê®Æ©ñ¸m¨ä¥LSheet¬O¤£¥h§ïÅܭ즳¸ê®Æ¥H«KÅçÃÒ,¦Ó¥Bµ{¦¡µù¸Ñ¤]¦³¼g©ñ¸m©ó²Ä¤G­ÓSheet
¦p­n§ï©ñ©ó¨ä¥L¦ì¸m©Î°µªk,µ{¦¡¤¤³£¦³µù¸Ñ,½Ð¦Û¦æ·L½Õ,ÁÂÁÂ!!

TOP

¦^´_ 30# wei9133

§A§â jcchiang«e½úªº ¥H¤U³o¬q§ï¤@¤U ¬Ý¬Ý ¬O¤£¬O§A­nªºµ²ªG

Sub ex3()
Dim d As Object, ar As Object, r
Dim i%, AA$, a
Application.ScreenUpdating = False
Set d = CreateObject("Scripting.Dictionary")
Set ar = Sheets(1).[a1].CurrentRegion

For i = 1 To ar.Rows.Count
   AA = Join(Application.Transpose(Application.Transpose(ar(i, 1).Resize(, 102))), ",") & "," & ar(i, 106) '«Ø¥ß§PÂ_±ø¥ó
   If Not d.exists(AA) Then   '¦r¨å¤º¬dµL¸Ó±ø¥ó
      a = Application.Transpose(Application.Transpose(ar(i, 1).Resize(, 115)))
      If a(103) = "" Then a(103) = 1 '³Ó³õªÅ¥Õ¶ñ¤J1
      d(AA) = a '±N¸ê®Æ©ñ¦^¦r¨å
   Else
      a = Application.Transpose(Application.Transpose(d(AA)))   '±N¦r¨å¸ê®Æ¨ú¥X
      If ar(i, 103) = "" Then a(103) = a(103) + 1 Else a(103) = a(103) + ar(i, 103) '³Ó³õªÅ¥Õ³Ó³õ²Ö¥[1,¤£¬OªÅ¥Õ«h±NÄæ¦ì­È¬Û¥[
      a(105) = a(105) + ar(i, 105) '±Ñ§½²Ö¥[
      For Each r In Array(104, 107, 109, 115) '±N³Æµù,DC,DE,DKÄæ¦ì¸ê®Æ¦X¨Ö
         If a(r) <> "" And ar(i, r) <> "" Then '¦pªG¦r¨å»PÄæ¦ì³£¦³¸ê®Æ,¨Ï¥Î","¬Û³s
            a(r) = a(r) & "," & ar(i, r)
         ElseIf a(r) = "" And ar(i, r) <> "" Then '¦pªG¦r¨å¸ê®Æ¬°ªÅ¥Õ,Äæ¦ì¬O¦³¸ê®Æªº,¨Ï¥ÎÄæ¦ì¸ê®Æ
            a(r) = ar(i, r)
         End If
      Next
      d(AA) = a   '±N¸ê®Æ©ñ¦^¦r¨å
   End If
Next
With Sheets(2)  '¦b²Ä¤G­ÓSheet¶ñ¤J¸ê®Æ
.[a1].CurrentRegion.Clear '²M°£Sheet¸ê®Æ
.[a1].Resize(d.Count, 115) = Application.Transpose(Application.Transpose(d.items)) '±N¦r¨å¸ê®Æ¦C¥X
'For Each r In .Range(.[cy2], .[cy2].End(4))  '«O¯d³Ó³õ+1
'   r.Value = r.Value + 1
'Next

End With
Set d = Nothing
Application.ScreenUpdating = True
End Sub

TOP

¦^´_ 31# jcchiang

30Fªº½T¬O§Úºâ¿ù¤F
¤O¶q­^¶¯À³¸Ó¬O4

(#23¼Ó:¦Ó³Ó³õ³¡¥÷ªº­È«h¤À§O¬°3¡BªÅ®æ¡B1¡A±Ñ³õªº­È«h¬°1¡BªÅ®æ¡BªÅ®æ
  ºâ¥X¨Ó¦X¨Öªº³Ó³õÄæ¦ìÀ³¬°"6"¡A±Ñ³õ«h¬°"1"
   ºâªk¬O³o¼Ëªº¡A°²³]3¨º®æ«O¯d¡A¦ÓªÅ®æ¥Nªí³Ó1³õ¡A³Ó³õ¶ñ¤J1ªº¹ê»Ú¤W¬O"·í¦C"¥["³Ó1³õ"
   ©Ò¥H¥[¥X¨Ó¬O"6")

²Ä¤G¬qªº³¡¤À§Aªº²z¸Ñ¬O¹ïªº

³Ó³õ(3,ªÅ,1)=6,¦pªG¥HªÅ¬°1,¹ê»Ú¤]¬O5,¦hªº1³õ¤£´N¬O¦Ó¥~¼W¥[ªº¶Ü??
³o­Ó¨ä¹ê§Ú¨S¬ÝÀ´

§Ú³o¼Ë¬Ý§A¯à¤£¯à²z¸Ñ
¬ö¿ý¥X¨Óªº·í¦C¡A¥»¨­´N¥Nªí¨º¦¸ªº³Ó³õ¡A·í§Ú²Î­p¨ì¤@¼Ò¤@¼Ëªº¹ï¾Ô¡A´N¦b³Ó³õ³B+1
©Ò¥H¨C¤@¦C³£¥Nªí¤F1¡A¦Ó³Ó³õ¬O¥t¥~¥[¤W¥hªº¡A¤~·|Åܦ¨³B²z¨ì¸Ó®æ­Y¸Ó®æ¦³­È­n+1¤W¥h
³Ó²v¨º®æ­YµL¥t¥~ªº¼Æ­È¡A¾ã¦Cµø¬°1

===================¤À¹j½u======================
§Ú®³¤F§A¦b28F´£¨Ñªºµ{¦¡½X¤U¥h°õ¦æ
¹Ï1

¹Ï¤@ªº²Ä¤@¸ò²Ä¤G¦C³Ó²vÄæ¦ì³£¬O0¡A¥Nªí¦U¦Û·í¦Cªº³Ó³õ¡A¦Ó³o¨â­Óµ²ºc³£¤@¼Ë
©Ò¥H¹B¦æ¥X¨ÓÀ³¸Ó¬O
¦X¨Ö°_¨Ó¡A³Ó²v¼g1  (¹ê»Ú¤W¬OĹ2³õ¨S¿ù¡A¦ý¦Û¤v³o¤@¦C´N¥Nªí¤F¤@³õ¡A©Ò¥H³Ó²v¨º®æ¥u·|¼g1)
²Ä¤T¦æ¬O¿W¦Û¦Û¤v¤@­Ó¡A¨S¦³¬Û¦P¦C¡A©Ò¥H´N¥u¦³«O¯d¡A¦Ü©ó³Ó²v¦]¬°¸Ó®æ¬O0¡A¥B¥u¦³¥¦¦Û¤v¡A©Ò¥HÀ³¸Ó¯dªÅ
§Ú·Q°õ¦æ¥X¨Óªºµ²ªG
¹Ï2

===============================================
¹ê»Ú°õ¦æ¥X¨Óªºµ²ªG
¹Ï3

§Ú°õ¦æªºµ²ªG¥X¨Ó·Pı¬O¡A³Ó²v¨º®æµL½×¬OªÅÁÙ¬O1³£·|³Qµø¬°1
¦ý¹ê»Ú¤WÀ³¸Ó¬O¸Ó¦Cµ¥©ó1¡A³Ó²v¨º®æ­Y¦³¼Æ¦r¡A
¥B¸Ó¦C­n³Q¨Ö¨ì¥t¤@¦Cªº¸Ü¡A´N­n¥H¸Ó®æ¼Æ¦r¥[¤W¦Û¤v³o¤@¦C¥Nªíªº1

¦Ó¬O³Ó²v¨º®æ¬OªÅ­È¥BµL¬Û¦P¦C¥i¦X¨Öªº¡A«O¯d¸Ó¦C¡A³Ó²v¨º®æ¤]´NÁÙ¬O0
(¦]¬°Ä¹ªº¨ÌÂÂ¥u¦³¤@³õ¡A¦Ó¨º³õ´N¬O¸Ó¦C¥»¨­)

==============================================
­Y³o¼Ë¯uªº«ÜÃø³Q²z¸Ñªº¸Ü¡A§Ú¥i¥H§ïÅܲέp¤è¦¡
¾ã¦C¤£¥Nªí¥ô¦ó¼Æ¦r¡AĹªº¦¸¼Æ¥þ¼g¦b³Ó²v¨ºùØ
³o­Ó²Õ¦XŤ@¦¸´N¼g1¡AŨ⦸´N¼g2
³o¼Ë´N¤£·|¦³­n­pºâ¥»¨­¦C¬°1ªº°ÝÃD¤F

§Aªº¾ã­Óµ{¦¡§Ú¦A¬ã¨s¬Ý¬Ý­n§ï­þ¸Ì¤~·|²Å¦X§Úªº»Ý¨D
·PÁ¨â¦ì

¹Ï1.png (16.24 KB)

¹Ï1.png

TOP

¦^´_  wei9133

§A§â jcchiang«e½úªº ¥H¤U³o¬q§ï¤@¤U ¬Ý¬Ý ¬O¤£¬O§A­nªºµ²ªG

Sub ex3()
Dim d As Ob ...
°a¤ªºµ µoªí©ó 2020-10-21 21:56

§A¦n
¦]¬°´ú¸Õ§¹
³Ó²v¨º®æµL½×¬OªÅÁÙ¬O1³£·|³Qµø¬°1¡A¦ý¹ê»Ú¤WÀ³¸Ó¬OªÅ¬°1¡A¼g1¹ê»ÚÀ³¬°2 (­n³Q¦X¨Öªºª¬ªp¤U)
¦Ó¤£³Q¦X¨Öªºª¬ªp¤UªÅ´N¬OªÅ¡A¸Ó®æ¤£À³¦³­È (¦]¬°¸Ó¦C¦Û¤v´N¬O1)
©Ò¥H¥uµù¸Ñ±¼°j°é¥[1ªº³¡¤ÀÁÙ¬O¨S¥Îªº
³Ó²v¨º®æ¦³­Èªº¥¿½T¤F¡AªÅªº´N·|¦³°ÝÃD¡A¤Ï¤§¥çµM
©Ò¥H§A§ïªº³o¼ËÁÙ¬O¤£¤Ó¹ï
·PÁ§A¤F

TOP

¦^´_ 33# wei9133

#33
¦³2³õ¤@¼Ë(³Ó²vÄ欰"ªÅ","ªÅ")¦X¨Ö³Ó²v¬°1
¥u¦³1³õ(³Ó²vÄ欰"ªÅ")³Ó²v¬°"ªÅ"

´XºØª¬ªp¦p¦ó­pºâ
2³õ(³Ó²v¬°"3","ªÅ")¦X¨Ö³Ó²v??(¬O§_¬°4)
3³õ(³Ó²v¬°"3","ªÅ","ªÅ")¦X¨Ö³Ó²v??(¬O§_¬°4)
3³õ(³Ó²v¬°"ªÅ","ªÅ","ªÅ")¦X¨Ö³Ó²v??(¬O§_¬°1)
3³õ(³Ó²v¬°"3","1","ªÅ")¦X¨Ö³Ó²v??(¬O§_¬°5)
4³õ(³Ó²v¬°"ªÅ","3","1","ªÅ")¦X¨Ö³Ó²v??(¬O§_¬°5)
¥u¦³¤@³õ¬O§_³Ó²vÄæ¦ì³£¤£ÅÜ
¦h³õªº¥u­n³Ó²v¬°ªÅªº¤£ºÞ´X³õ³£¥uºâ1³õ³Ó³õ,¨ä¾l³Ó²vÄ榳­Èªºª½±µ²Ö¥[­È

TOP

¦^´_ 33# wei9133

1.¸ê®Æ¦ì¸m©ñ¸m²Ä¤G­Ósheet,½Ð¦Û¦æ­×§ï©ñ¸m¦ì¸m
2.³Ó³õ­pºâ¤è¦¡
-->¥u¦³1µ§¸ê®Æ,³Ó³õ³£¤£ÅÜ°Ê
-->2µ§¥H¤W¸ê®Æ,©Ò¦³ªº"ªÅ"³£ºâ¼W¥[1³õ,¦³­Èªºª½±µ²Ö¥[

Sub ex4()
Dim d As Object, ar As Object, r
Dim i%, AA$, a
Application.ScreenUpdating = False
Set d = CreateObject("Scripting.Dictionary")
Set ar = Sheets("¹ï¾Ô²Î­p").[a1].CurrentRegion

For i = 1 To ar.Rows.Count
   AA = Join(Application.Transpose(Application.Transpose(ar(i, 1).Resize(, 102))), ",") & "," & ar(i, 106) '«Ø¥ß§PÂ_±ø¥ó
   If Not d.exists(AA) Then   '¦r¨å¤º¬dµL¸Ó±ø¥ó
      a = Application.Transpose(Application.Transpose(ar(i, 1).Resize(, 115)))
      ReDim Preserve a(1 To UBound(a) + 2)
      If a(103) = "" Then a(UBound(a) - 1) = 1 '¬ö¿ý³Ó³õªÅ¥Õ¼Æ
      a(UBound(a)) = 1 '¬ö¿ýµ§¼Æ
      d(AA) = a '±N¸ê®Æ©ñ¦^¦r¨å
   Else
      a = Application.Transpose(Application.Transpose(d(AA)))   '±N¦r¨å¸ê®Æ¨ú¥X
      If ar(i, 103) = "" Then a(UBound(a) - 1) = a(UBound(a) - 1) + 1 Else a(103) = a(103) + ar(i, 103) '³Ó³õªÅ¥Õ¬ö¿ý²Ö¥[1,¤£¬OªÅ¥Õ«h±NÄæ¦ì­È¬Û¥[
      a(UBound(a)) = a(UBound(a)) + 1 ''¬ö¿ýµ§¼Æ+1
      a(105) = a(105) + ar(i, 105) '±Ñ§½²Ö¥[
      For Each r In Array(104, 107, 109, 115) '±N³Æµù,DC,DE,DKÄæ¦ì¸ê®Æ¦X¨Ö
         If a(r) <> "" And ar(i, r) <> "" Then '¦pªG¦r¨å»PÄæ¦ì³£¦³¸ê®Æ,¨Ï¥Î","¬Û³s
            a(r) = a(r) & "," & ar(i, r)
         ElseIf a(r) = "" And ar(i, r) <> "" Then '¦pªG¦r¨å¸ê®Æ¬°ªÅ¥Õ,Äæ¦ì¬O¦³¸ê®Æªº,¨Ï¥ÎÄæ¦ì¸ê®Æ
            a(r) = ar(i, r)
         End If
      Next
      d(AA) = a   '±N¸ê®Æ©ñ¦^¦r¨å
   End If
Next
With Sheets(2)  '¦b²Ä¤G­ÓSheet¶ñ¤J¸ê®Æ
.[a1].CurrentRegion.Clear '²M°£Sheet¸ê®Æ
.[a1].Resize(d.Count, UBound(a)) = Application.Transpose(Application.Transpose(d.items)) '±N¦r¨å¸ê®Æ¦C¥X
For Each r In .Range(.[cy2], .[cy65535].End(3))
   If r.Offset(, 14) > 1 And r.Offset(, 13) > 0 Then r.Value = r.Value + 1 '2µ§¸ê®Æ¥H¤W¥B¦³³Ó³õ¬°"ªÅ"ªº³Ó³õ+1
Next
i = .[a1].CurrentRegion.Columns.Count
.Range(Cells(1, i - 1), Cells(65535, i).End(3)).Clear '²M°£ªÅ¥Õ&¸ê®Æ­pºâµ§¼Æ
End With
Set d = Nothing
Application.ScreenUpdating = True
End Sub

TOP

²Õ¦X1--a/b/d/f/h-¤HÃþ(³Ó¤è)   ²Õ¦X2--b/d/e/f/g-¤HÃþ(±Ñ¤è) --- ¦@¥X²{5¦¸
²Õ¦X2--b/d/e/f/g-¤HÃþ(³Ó¤è)   ²Õ¦X1--a/b/d/f/h-¤HÃþ(±Ñ¤è) --- ¦@¥X²{3¦¸
ÁöµM¥ª¥k¹ï½Õ, ¦ýÀ³ºâ¦P¤@²Õ¦X¹ï¾Ô§a!

²Õ¦X1--a/b/d/f/h-¤HÃþ -- ³Ó5±Ñ3
²Õ¦X2--b/d/e/f/g-¤HÃþ -- ³Ó3±Ñ5

³o³Ó±Ñ²v¦p¦ó­pºâ???

TOP

¥»©«³Ì«á¥Ñ °a¤ªºµ ©ó 2020-10-24 21:11 ½s¿è

¦^´_ 34# wei9133

½Ð°Ý§A­nªºµ²ªG¬O¤£¬O³o¼Ë
¥ý¥ª¥k¤ñ¹ï ­Y¬O 1~51  ¸ò 52~102 ¬Û¦P®É + ¬P¶H106 ¦¹®É(³Ó²v =  "" ©Î ±Ñ§½ = ""  ¥»¨­´N¬O =1 ©ÎµÛ =-1 ?)  ·í§@´M§ä¤ñ¹ïªº¥Ø¼Ð  
¦A´M§ä¤ñ¹ï¤W¤U 1~102 + ¬P¶H106 ­Y¬Û¦P®É  ¦b¬Ý 103³Ó²v  ¸ò  105±Ñ§½ ¶i¦æ²Ö¥[
²Ö¥[«áªº¼Æ­È­n¦b ¦X¨Ö¸Ó¦Cªº¶¶§Ç¤W
¦X¨Ö¸Ó¦Cªº¶¶§Ç¬O   ¥ý107 A  ­Y =""  ´N¦X¨Ö¦b 109  X   ­Y ="" ´N¦X¨Ö¦b   115¼È¦s   ­Y =""  ´N¦X¨Ö¦b  104³Æµù
ÁÙ¬O»¡ ´N¹³ jcchiang «e½ú ¸ò ­ã´£¤j¤j ©Ò»¡ªº ³o¼Ë½ÆÂøªº²Õ¦Xºâªk?
©ÎµÛ¯à§_²³æ©úÁA´N¦n §Ú¹ê¦b¤£¤Ó©ú¥Õ©êºp...¤p§Ì¼Æ¾Ç¤£¦n

TOP

¦^´_ 34# wei9133

¦³ªÅÀ°§Ú¬Ý¤@¤U ¬O¤£¬O³o¼Ëªºµ²ªG ÁÂÁÂ

javascript:;

¹ï¾Ô²Î­p -1025.rar (699.95 KB)

TOP

¥»©«³Ì«á¥Ñ °a¤ªºµ ©ó 2020-10-25 10:49 ½s¿è

¦^´_ 34# wei9133

·Pı±Ñ§½ ©Ç©Çªº ©Ò¥H§ï¤F¤@¤U ¦³ªÅÀ°§Ú¬Ý¤@¤U ·PÁ ¶]ªº³t«×ºC¤F¤@¨Ç ¤£ª¾¦p¦ó¥[§Ö³t«×.....
  1. Public Sub ½m²ß1025()
  2. Application.ScreenUpdating = False
  3. Sheets(1).Select
  4. Sheets(2).[a1].CurrentRegion.Clear
  5. Dim Arr, D, xD, xD1, x&, y&, k&, T1$, T2$, T3$, T4$
  6. Set xD = CreateObject("Scripting.Dictionary")
  7. Set xD1 = CreateObject("Scripting.Dictionary")
  8. Arr = Range(Cells(Rows.Count, 1).End(xlUp), Cells(1, 115))
  9. For x = 2 To UBound(Arr, 1)
  10.     T1 = ""
  11.     For y = 1 To 51
  12.         T1 = T1 & Arr(x, y)
  13.         If Arr(x, y) = "" Then T1 = T1 & "-"
  14.     Next y
  15.     T3 = ""
  16.     For y = 52 To 102
  17.         T3 = T3 & Arr(x, y)
  18.         If Arr(x, y) = "" Then T3 = T3 & "-"
  19.     Next y
  20.     If T1 = T3 Then
  21.        T1 = T1 & T3 & Arr(x, 106)
  22.        T3 = ""
  23.         If Arr(x, 103) = "" Then
  24.            Arr(x, 103) = 1
  25.            xD(T1) = xD(T1) + Arr(x, 103)
  26.         ElseIf Arr(x, 103) <> "" Then
  27.            xD(T1) = xD(T1) + Arr(x, 103)
  28.         End If
  29.         xD1(T1) = xD1(T1) + Arr(x, 105)
  30.     End If
  31. Next x
  32. T1 = "": T3 = ""
  33. For Each D In xD
  34.     For x = UBound(Arr, 1) To 2 Step -1
  35.         T2 = ""
  36.         For y = 1 To 51
  37.             T2 = T2 & Arr(x, y)
  38.             If Arr(x, y) = "" Then T2 = T2 & "-"
  39.         Next y
  40.         T4 = ""
  41.         For y = 52 To 102
  42.             T4 = T4 & Arr(x, y)
  43.             If Arr(x, y) = "" Then T4 = T4 & "-"
  44.         Next y
  45.         If T2 = T4 Then
  46.             T2 = T2 & T4 & Arr(x, 106)
  47.             T4 = ""
  48.             If D = T2 Then
  49.                 Arr(x, 103) = xD(D)
  50.                 Arr(x, 105) = xD1(D)
  51.             End If
  52.         End If
  53.     Next x
  54. Next D
  55. T2 = "": T4 = "": D = "": k = 1
  56. For x = 2 To UBound(Arr, 1)
  57.     If Arr(x, 103) <> "" Or Arr(x, 105) <> "" Then
  58.         If Arr(x, 107) <> "" Or Arr(x, 109) <> "" _
  59.         Or Arr(x, 115) <> "" Or Arr(x, 104) <> "" Then
  60.             k = k + 1
  61.         End If
  62.         For y = 1 To UBound(Arr, 2)
  63.             If Arr(x, 107) <> "" Or Arr(x, 109) <> "" _
  64.             Or Arr(x, 115) <> "" Or Arr(x, 104) <> "" Then
  65.                 Arr(k, y) = Arr(x, y)
  66.             End If
  67.         Next y
  68.     End If
  69. Next x
  70. Set xD = Nothing
  71. Set xD1 = Nothing
  72. Sheets(2).Range("A1").Resize(k, UBound(Arr, 2)) = ""
  73. Sheets(2).Range("A1").Resize(k, UBound(Arr, 2)) = Arr
  74. Erase Arr
  75. Sheets(2).Select
  76. Application.ScreenUpdating = True
  77. End Sub
½Æ»s¥N½X

TOP

        ÀR«ä¦Û¦b : ±o²z­nÄǤH¡A²zª½­n®ð©M¡C
ªð¦^¦Cªí ¤W¤@¥DÃD