[µo°Ý] ¦Û°Ê®Mªí

PJChen

Dear,
§Ú¤£ª¾¹D³o­Ó®Mªí°ÝÃD¯à§_¥Î¨ç¼Æ¸Ñ¨M,¦ý¦]¬°ªí®æ¤¤ªº¸ê®Æ¤j¦h¥Î¨ç¼Æ®M¥X¨Óªº,©Ò¥H¦b³o¸Ìµo°Ý...    ¦Û°Ê®Mªí.rar (34.84 KB)

¤U¸ü¦¸¼Æ: 13

2019-11-5 19:00

        ¥X³fsheet¬O¤@­Ó¨C¤Ñ¥X³f¥Îªºªí®æ,©Ò¥H¸ê®Æ¬OÅܰʪº
        ¦]¬°Àɮ׫ܤj,§Ú§â»P¸É³f©ú²ÓµLÃöªº¸ê®Æ³£Delete,ÁקK¤zÂZ
        ¨C¤Ñªº¯Ê³f³£»Ý­n³o±i³øªí¥hµoµ¹¸É³fªº³æ¦ì
        °£¤FªíÀY1:2¥~,³o±i³øªí¨C¤Ñªì©l³£¬OªÅ¥Õªº
        §Ú­n§â¥X³fsheetªº¸ê®Æ®M¶i¨Ó,½Ð±Ð¥Î¨ç¼Æ¤ñ¸û¦n°µ,ÁÙ¬OVBA?
       
        ¥X³fsheet­n®M¹L¨Óªº³f®Æ:
1..        ¦³¯Ê³fªº³¡¥÷¡A¨Ì§Ç±qAS:BH±a¸ê®Æ
2..        §Ú¥ý°µ¤@­Ó2­Ó½d¨Ò"ªL¤f" & "·x·x1"
3..        ²{¦bµLªk¹F¦¨ªº³¡¥÷¦b©ó
        ­n¦p¦óÅý¦³¯Ê³fªºAS:BHªºªíÀY¦Û°Ê±a¨ì³o¸ÌªºBÄæ?¦ýµL¯Ê³fªº¦Û°Ê¸õ¹L¡I
        ¨Ã¥BÅý¯Ê³fªº®Æ¸¹¦Û°Ê±a¨ìAÄæ?
4..        ²Ä2µ§¯Ê³fªºªíÀY "·x·x1"±a¤JBÄæ,®Æ¸¹¦Û°Ê±a¨ìAÄæ«á
        ¦p¦óÅýEÄ檺¤½¦¡¥H·x·x1¬°¹ï¶H?¦Ó¤£¥Î¦U§O­×§ï¤½¦¡?
¨Ò¡G        =SUMPRODUCT((¥X³f!$F$4:$F$12=$A7)*(¥X³f!$AS$3:$BH$3=B$6)*(¥X³f!$AS$4:$BH$12))
        ¦p¦óÅý(¥X³f!$AS$3:$BH$3¦Û°Ê·j´MB$6),¦Ó¤£¥Î¦U§O§ï?

Andy2483

¦^´_ 31# ­ã´£³¡ªL
ÁÂÁ«e½ú
«á¾Ç¥Î¨â­Ó°}¦C+¨â­Ó¦r¨å³B²z,½Ð«e½ú¦A«ü¾É!

Option Explicit
Sub TEST_20221028()
Dim Arr, Brr, i&, j&, X, Y, C, R
R = [­¸¤ñ!HE65536].End(xlUp).Row
Arr = Sheets("­¸¤ñ").Range("F1:F" & R)
Brr = Sheets("­¸¤ñ").Range("HD1:HE" & R)
Set X = CreateObject("Scripting.Dictionary")
Set Y = CreateObject("Scripting.Dictionary")
For i = 4 To R
   If Val(Brr(i, 1)) > 0 Then
      X(Brr(i, 1) & "|" & i) = Arr(i, 1)
   End If
   If Val(Brr(i, 2)) > 0 Then
      Y(Brr(i, 2) & "|" & i) = Arr(i, 1)
   End If
Next
With Sheets("³Ì«á®Ä´Á")
   .[J4:K4].Resize(R).ClearContents
   .[L5:AB5].Resize(R).ClearContents
   .[A5:H5].Resize(R).ClearContents
   If X.Count > 0 Then
      .[J4].Resize(X.Count, 1) = Application.Transpose(X.items)
   End If
   If Y.Count > 0 Then
      .[K4].Resize(Y.Count, 1) = Application.Transpose(Y.items)
   End If
   C = IIf(X.Count >= Y.Count, X.Count, Y.Count)
   If C <= 1 Then Exit Sub
   .[L4:AB4].Copy .[L5:AB5].Resize(C - 1)
   .[A4:H4].Copy .[A5:H5].Resize(C - 1)
End With
End Sub
Sub ²M°£()
With Sheets("³Ì«á®Ä´Á")
   .[J4:K4].Resize(100).ClearContents
   .[L5:AB5].Resize(100).ClearContents
   .[A5:H5].Resize(100).ClearContents
End With
End Sub

Andy2483

¦^´_ 31# ­ã´£³¡ªL
'ÁÂÁ«e½ú
'«á¾Ç¦b¦¹©«¾Ç²ß¨ì
'1.¨S¦³²`¤J¾Ç²ß±o¤£¨ìºëµØ
'2.²ß±o§å¦¸«Å§iÅܼƥB§å¦¸¼Æ»P°j°é·f°t¨Ï¥Î!ªì¶}©l¥u¥H¬°¤Ö«Å§i´X­ÓÅܼÆ
'3.²ß±o If N(j) > NN Then ¨ú³Ì¤j¼Æªº¤èªk
'4.²ß±o [J4:K4].Resize(NN) = Crr,¥H«e¥u·| [J4].Resize(NN,2)
'5.©P¨ìªº¨¾¿ù»Ý­n¦A²Ö¿n¸gÅç!¤~¯à¿ì¨ì
¥H¤U¤ß±oµù¸Ñ½Ð¦b«ü±Ð! ÁÂÁ«e½ú

Sub ³Ì«á®Ä´Á()
Dim Arr, Brr, Crr, R&, i&, j%, N&(1 To 2), NN&, BK As Workbook
'¡ô«Å§iÅܼÆ
R = [­¸¤ñ!HE65536].End(xlUp).Row
'¡ô¥OR¬O HEÄæÀx¦s®æ¦³¤º®eªº³Ì«á¤@¦C¼Æ
Arr = Sheets("­¸¤ñ").Range("F1:F" & R)
'¡ô¥OArr¬O°}¦C ­Ë¤J­¸¤ñªí ªºF1¨ì
'FÄ檺(HEÄæÀx¦s®æ¦³¤º®eªº³Ì«á¤@¦C¼Æ) ªº­È
Brr = Sheets("­¸¤ñ").Range("HD1:HE" & R)
'¡ô¥OBrr¬O°}¦C ­Ë¤J­¸¤ñªí ªºHD1¨ì
'HEÄ檺(HEÄæÀx¦s®æ¦³¤º®eªº³Ì«á¤@¦C¼Æ) ªº­È
ReDim Crr(1 To R, 1 To 2)
'¡ô«Å§iCrr°}¦Cªº¤j¤p ºî¤è¦V 1¨ì HEÄæÀx¦s®æ¦³¤º®eªº³Ì«á¤@¦C¼Æ
'¾î¤è¦V 1 ¨ì 2
For i = 4 To R
'¡ô³]¥~¶¶°j°é ±q4 ¨ì R
   For j = 1 To 2
   '¡ô³]¤º¶¶°j°é ±q 1 ¨ì 2
      If Val(Brr(i, j)) > 0 Then
      '¡ô¦pªG ´f ²Î ³o¨âÄæ¸Ìªº­È¤j©ó0
         N(j) = N(j) + 1
         '¡ôN¬O³o¨âÄæ²Å¦XIf±ø¥ó¦¸¼ÆªºÅܼÆ!ªì©l­È¬O0
         Crr(N(j), j) = Arr(i, 1)
         '¡ôCrr°}¦C±q²Ä¤@¦C¶}©l©ñ¤J²Å¦X±ø¥ó ªº½¦±aÃC¦â
         If N(j) > NN Then
         '¡ô¦pªG¤j©ó NN
         '¡ô·íN(j)=1®É,NNªºªì©l­È¬O0 !±ø¥ó¦¨¥ß
            NN = N(j)
            '¡ô±ø¥ó¦¨¥ß!´NÅýNN =²Å¦XIf±ø¥ó¦¸¼Æ
            '¡ô·íN(j)=1®É ±ø¥ó¦¨¥ß! NN=1
            '¡ô«áÄò¦pªG N(1) N(2)¤£¬Ûµ¥!NN·|¸Ë¤J³Ì¤j¼Æ
         End If
      End If
   Next j
Next i
If NN = 0 Then
'¡ô¦pªGN()ªº³Ì¤j¼ÆNN ¬O0!§¹¥þ¨S¦³²Å¦X±ø¥óªº¸ê®Æ
   Exit Sub
   '¡ôµ²§ôµ{§Ç
End If
With Sheets("³Ì«á®Ä´Á")
'¡ô±µ¤U¨ÓÃö©ó ³Ì«á®Ä´Áªíªº¬ÛÃöµ{§Ç(«e­±¦³ ªÅ¥Õ+"."²Å¸¹ªº")
    .[J4:K4].Resize(NN) = Crr
    '¡ô¥Ñ ³Ì«á®Ä´Áªí ªº[J4:K4](§t)¶}©l¦V¤UÂX®i NN¦Cªº½d³ò¶K¤JCrrªº­È
    'ÁöµM ReDim Crr(1 To R, 1 To 2)«Å§iªº½d³ò¤ñ ³Ì«áµ²ªG½d³ò¤j!
    '¦ý¬Oºë·Ç­pºâ!¦³®ÄResizeÂX®iµ²ªG½d³ò,´N¤£·|¼vÅT¨ä¥LÀx¦s®æ
    If NN <= 1 Then Exit Sub
    '¡ô¦pªGN()ªº³Ì¤j¼ÆNN=1,´N µ²§ôµ{§Ç
    .[L4:AB4].Copy .[L5:AB5].Resize(NN - 1)
    '¡ô±N ³Ì«á®Ä´Áªí[L4:AB4]Àx¦s®æ ½Æ»s¨ì
    '³Ì«á®Ä´Áªí[L5:AB5](§t)¶}©l¦V¤UÂX®i NN-1¦C
    .[A4:H4].Copy .[A5:H5].Resize(NN - 1)
    '¡ô±N ³Ì«á®Ä´Áªí[A4:H4]Àx¦s®æ ½Æ»s¨ì
    '³Ì«á®Ä´Áªí[A5:H5](§t)¶}©l¦V¤UÂX®i NN-1¦C
End With
End Sub

­ã´£³¡ªL

¦^´_ 30# PJChen

Sub ³Ì«á®Ä´Á()
Dim Arr, Brr, Crr, R&, i&, j%, N&(1 To 2), NN&, BK As Workbook
'Set BK = Workbooks("³Ì·s®w¦s.xlsx")
'BK.Sheets("³Ì«á®Ä´Á").Activate
R = [­¸¤ñ!HE65536].End(xlUp).Row
Arr = Sheets("­¸¤ñ").Range("F1:F" & R)
Brr = Sheets("­¸¤ñ").Range("HD1:HE" & R)
ReDim Crr(1 To R, 1 To 2)
For i = 4 To R
For j = 1 To 2
    If Val(Brr(i, j)) > 0 Then
       N(j) = N(j) + 1: Crr(N(j), j) = Arr(i, 1)
       If N(j) > NN Then NN = N(j)
    End If
Next j
Next i
If NN = 0 Then Exit Sub
With Sheets("³Ì«á®Ä´Á")
    .[J4:K4].Resize(NN) = Crr
    If NN <= 1 Then Exit Sub
    .[L4:AB4].Copy .[L5:AB5].Resize(NN - 1)
    .[A4:H4].Copy .[A5:H5].Resize(NN - 1)
End With
End Sub

PJChen

¦^´_ 29# ­ã´£³¡ªL

­ã¤j,
1) ¦p¹Ï,¦p¦ó¨ÏJÄæ&KÄæ¸ê®Æ¥i¥H³sÄò,¥B³£±q²Ä4¦C¶}©l¸ü¤J¸ê®Æ?
2) ½Ð°ÝFor i = 4 To R
¸Ó¦p¦ó²z¸Ñ¬õ¦r³¡¥÷?¬°¦ó¬O4?

¤U¸ü (7.88 KB)

2020-6-16 16:52

³Ì·s®w¦sA.rar (85.21 KB)

¤U¸ü¦¸¼Æ: 2

2020-6-16 16:52

­ã´£³¡ªL

¦^´_ 28# PJChen


Sub ³Ì«á®Ä´Á()
Dim Arr, Brr, Crr, R&, i&, N&, BK As Workbook
Set BK = Workbooks("³Ì·s®w¦s.xlsx")
BK.Sheets("³Ì«á®Ä´Á").Activate
R = [­¸¤ñ!HE65536].End(xlUp).Row
Arr = Sheets("­¸¤ñ").Range("F1:F" & R)
Brr = Sheets("­¸¤ñ").Range("HD1:HE" & R)
ReDim Crr(1 To R, 1 To 2)
For i = 4 To R
    If Val(Brr(i, 1)) + Val(Brr(i, 2)) = 0 Then GoTo 101
    N = N + 1
    If Brr(i, 1) > 0 Then Crr(N, 1) = Arr(i, 1)
    If Brr(i, 2) > 0 Then Crr(N, 2) = Arr(i, 1)
101: Next i
If N = 0 Then Exit Sub
With Sheets("³Ì«á®Ä´Á")
    .[J4:K4].Resize(N) = Crr
    If N > 1 Then
      .[L4:AB4].Copy .[L5:AB5].Resize(N - 1)
      .[A4:H4].Copy .[A5:H5].Resize(N - 1)
    End If
End With
End Sub

PJChen

¦^´_ 27# ­ã´£³¡ªL

³Ì«á®Ä´Á,A4:H4,L4:AB4­ì¨Ó³£¦³¤½¦¡,§@¬°°ÊºAªí®æ¨Ï¥Î,
µ{¦¡¥u¦³°µ¤G­Ó°Ê§@:
1) ±N¨Ó·½®Æ¸¹¶ñ¤JJ:KÄæ,
2) ³Ì«á¨Ì¾ÚKÄ檺¦C¼Æ,±NA4:H4,L4:AB4ªº¤½¦¡¤U©Ô§Y¥i  
³Ì«á®Ä´Á.rar (82.19 KB)

¤U¸ü¦¸¼Æ: 2

2020-6-16 12:42

¤U¸ü (22.64 KB)

2020-6-16 12:41

­ã´£³¡ªL

¦^´_ 26# PJChen

§A³oµ{¦¡½X®Ú¥»®³¤£¨ì¥ô¦ó¸ê®Æ!!!
À³¸Ó¬O§¹¥þ¤£¤F¸Ñ­ìµ{¦¡½Xªº·N«ä, ³o¼Ë¬OµLªk®M¥Îªº~~

¥ú¬O³o¤£¦¨®Mªºµ{¦¡½X¤Î²³æªº»¡©ú, µLªk¤F¸Ñ¸Ô²Ó»Ý¨D³W«h,
¦n¹³¨C¦¸ªº´£°Ý, §Ú´X¥G³£§ì¤£¨ì­nªº¬O¤°»ò???¥u¯à¥Î²q,
³oÁ`¤£¬O¿ìªk, ©Î³\¦A¬ã¨s¤@¤U´£°Ý¤è¦¡, Åý§O¤H³£¥i¤F¸Ñ²M·¡§Aªº¥Øªº!!!

PJChen

¦^´_ 23# ­ã´£³¡ªL

­ã¤j,
§Ú­×§ï¤F³o­Óµ{¦¡,·QÅý
HDÄæ>0,«h¶ñ¤J,³Ì«á®Ä´ÁsheetªºJÄæ
HEÄæ>0,«h¶ñ¤J,³Ì«á®Ä´ÁsheetªºKÄæ
¥Ø«e¥utry¤FHEÄæ,¦ýµLªk¶ñ¤J,¥i¥HÀ°§Ú¬Ý¬Ý¶Ü?    ³Ì·s®w¦s.rar (82.58 KB)

¤U¸ü¦¸¼Æ: 1

2020-6-16 00:14

1. Sub  ³Ì«á®Ä´Á()
   
2. Dim Arr, Brr, R&, ²Î&, N&, BK As Workbook
   
3. Set BK = Workbooks("³Ì·s®w¦s.xlsx")
   
4. BK.Sheets("³Ì«á®Ä´Á").Activate
   
5. Arr = Range([­¸¤ñ!A1], [­¸¤ñ!HE65536].End(xlUp))
   
6. For R = 4 To UBound(Arr)
   
7.     ²Î = Val(Arr(R, UBound(Arr, 2)))
   
8.     If ²Î = 0 Then GoTo 101
   
9.     N = N + 1
   
10.     Arr(N, 11) = Arr(R, 5) '®Æ¸¹
    
11. 101: Next R
    
12. If N = 0 Then Exit Sub
    
13. 
    
14. With [³Ì«á®Ä´Á!A4:H4].Resize(N)
    
15.      .Rows(1).Copy .Cells
    
16. End With
    
17. With [³Ì«á®Ä´Á!L4:AB4].Resize(N)
    
18.      .Rows(1).Copy .Cells
    
19. End With
    
20. End Sub

½Æ»s¥N½X

PJChen

¦^´_ 23# ­ã´£³¡ªL

­ã¤j,
·PÁ§A,§Ú§ï¦n¤F