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

[µo°Ý] ¦Û°Ê±a¤J

[µo°Ý] ¦Û°Ê±a¤J

½Ð°Ý¦p¦ó±NSheet1¤¤¦³¼Æ¶qªº¦Û°Ê±a¤Jsheet2ªºªí®æ¤¤©O¡C

A1.rar (6.81 KB)

a2=IF(COUNTIF(Sheet1!$D$2:$D$20,"<>")>=ROW(A1),INDEX(Sheet1!A:A,SMALL(IF(Sheet1!$D$2:$D$20<>"",ROW($D$2:$D$20)),ROW(1:1))),"")  °}¦C¤½¦¡

TOP

¦^´_ 1# ahui
ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
¤µ¤Ñ½m²ß¹B¥Î°}¦C»P¦r¨å
¸ê®Æªí¼Æ¶qÄ椣¬OªÅ®æ´N±a¤J¨ìµ²ªGªí¨Ã¥[Á`ª÷ÃB
A1_20221026_4.zip (19 KB)

¸ê®Æªí:


µ²ªGªí:

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2022-10-26 13:29 ½s¿è

«á¾Ç¾Ç²ß¤ß±o¦p¤U!
½Ð¦U¦ì«e½ú«ü¥¿¨Ã«ü¾É!ÁÂÁÂ
Option Explicit
Sub TEST()
Dim Brr, i&, T(5), TT, V&, Y, Z
Dim A, B
'¡ô«Å§iÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OY¬°¦r¨å
Set A = Sheets(1)
'¡ô¥OA¬O²Ä¤@­Ó¤u§@ªí
Set B = Sheets(2)
'¡ô¥OA¬O²Ä¤G­Ó¤u§@ªí
Brr = A.[A1].CurrentRegion
'¡ô¥OBrr¬O°}¦C,­Ë¤Jªí¤@[A1]³s±µ¨ìªºÀx¦s®æ
',ÂX®i¦Ü³Ì¤p¤è¥¿°Ï°ìÀx¦s­Óªº­È

For i = 1 To UBound(Brr)
'¡ô³]¶¶°j°é±N²Å¦X±ø¥óªº¦C­Ë¤JY¦r¨å¸Ì
   T(1) = Brr(i, 1)
   T(2) = Brr(i, 2)
   T(3) = Brr(i, 3)
   T(4) = Brr(i, 4)
   T(5) = Brr(i, 5)
   TT = T(1) & "|" & T(2)
   If T(4) <> "" Then
      If Y.Exists(TT) Then
      '¡ô¦pªG§PÂ_Y¦r¨å¸Ì¦³¸ê®Æ?
         MsgBox i & " ¦C¼tµP+³W®æ ¦³­«½Æ!¤£¤¹³\°õ¦æ"
       '¡ô¦]¬°«á¾Ç³]©wªº±¡¹Ò ¼tµP+³W®æ ¤£­«½Æ,´N¸Ó¦³Àˬd¾÷¨î
         '§_«h¼Æ¶q·|¥u§ì³Ì«á¤@µ§,¦Ó¦X­p­È«o¤w²Ö¥[ª÷ÃB

         GoTo 333
         '¡ô¸õ¨ì 333 ¦ì¸mÄ~Äò°õ¦æ!
      End If
      Y(TT) = Array(T(1), T(2), T(3), T(4), T(5))
      If IsNumeric(T(5)) Then
      '¡ô¦pªG§PÂ_²Ä5Ä檺¸ê®Æ¬O¼Æ¦r?
      '¦]¬°[E1] ¬O "ª÷ÃB"¦r¦ê,©Ò¥H­nÂo±¼«D¼Æ¦r!
         V = V + T(5)
         '¡ôª÷ÃB²Ö¥[
      End If
   End If
Next
TT = "Á`­p"
'¡ô¥OTT¬O "Á`­p" ¦r¦ê
Y(TT) = Array(TT, "", "", "", V)
'¡ô§â "Á`­p" ·íkey,¤@ºû°}¦C·íitem
'¡ô¦³¤@ÂI«Ü­«­n! Y(TT) = Array(TT, , , , V) ¨S¦³¿ìªk°õ¦æ!
B.UsedRange.EntireRow.Delete
'¡ô§R°£ªí¤G ¦³¨Ï¥Îªº¦C
B.[A1].Resize(Y.Count, 5) = Application.Transpose(Application.Transpose(Y.items))
'¡ô§âY¦r¨åªºItemÂà¸m¶K¤J ±qªí¤Gªº[A1] ¶}©l
B.Range(B.Cells(Y.Count, 1), B.Cells(Y.Count, 5)).Interior.ColorIndex = 6
'¡ôªí¤GªºÁ`­p¨º5®æ©³¦â§ï¬° ¶À¦â6

333
Set Y = Nothing
Set Brr = Nothing
End Sub

TOP

«á¾Ç¤U¤È½m²ß¤F°}¦C+¦r¨å+¦r¨å¤¤¦r¨å
¦r¨å¤¤¦r¨å«ÜÃø!±q³Ì²³æ¾Ç°_!
¤ß±oµù¸Ñ¦p¤U!½Ð«e½ú­Ì«ü¥¿¨Ã«ü¾É!

Sub TEST_2()
Dim Brr, i&, T(5), TT, V&, Y, Z, x, C
Dim A, B
'¡ô«Å§iÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OY¬°¦r¨å
Set A = Sheets(1)
'¡ô¥OA¬O²Ä¤@­Ó¤u§@ªí
Set B = Sheets(2)
'¡ô¥OA¬O²Ä¤G­Ó¤u§@ªí
Brr = A.[A1].CurrentRegion
'¡ô¥OBrr¬O°}¦C,­Ë¤Jªí¤@[A1]³s±µ¨ìªºÀx¦s®æ
',ÂX®i¦Ü³Ì¤p¤è¥¿°Ï°ìÀx¦s­Óªº­È

For i = 1 To UBound(Brr)
'¡ô³]¶¶°j°é±N²Å¦X±ø¥óªº¦C­Ë¤JY¦r¨å¸Ì
   If Brr(i, 4) <> "" Then
   '¡ô¦pªG¼Æ¶qÄ椣¬OªÅ®æ??
      TT = Brr(i, 1) & "|" & Brr(i, 2)
      '¡ô¥OTT¬O ¼tµP&"|"&³W®æªº²Õ¦X¦r¦ê
      If Y.Exists(TT) Then
      '¡ô¦pªG§PÂ_Y¦r¨å¸Ì¦³¸ê®Æ?
         MsgBox i & " ¦C¼tµP+³W®æ ¦³­«½Æ!¤£¤¹³\°õ¦æ"
        '¡ô¦]¬°«á¾Ç³]©wªº±¡¹Ò ¼tµP+³W®æ ¤£­«½Æ,´N¸Ó¦³Àˬd¾÷¨î
         '§_«h¼Æ¶q·|¥u§ì³Ì«á¤@µ§,¦Ó¦X­p­È«o¤w²Ö¥[ª÷ÃB

         GoTo 333
      End If
      x = x + 1
      '¡ô²Å¦X±ø¥ó!´N¶}©l¾Q³¯ ¦r¨åªºKey¬O¥¼¨Óªº¦C¸¹!²Ö¥[1
      Set Y(x) = CreateObject("Scripting.Dictionary")
      '¡ô¥OY(x)³oitem¬O¦r¨å¤¤ªº¦r¨å
      Y(x)(1) = Brr(i, 1)
      Y(x)(2) = Brr(i, 2)
      Y(x)(3) = Brr(i, 3)
      Y(x)(4) = Brr(i, 4)
      Y(x)(5) = Brr(i, 5)
      '¡ô³°ÄòÅý¦r¨å¤¤ªº¦r¨åkey¬O¥¼¨ÓªºÄ渹,item¬O¸ê®Æªíªº­È
      TT = Y(x)(1) & "|" & Y(x)(2)
      '¡ô¥OTT¬O¦r¨å¤¤¦r¨åªº ²Ä1­Óitem& "|" &²Ä2­Óitem ªº²Õ¦X¦r¦ê
      Y(TT) = 1
      '¡ô³o¬O²K¶i¥h¦r¨åµ¹¤U¤@½ü°j°é§P©w­«½Æ¥Îªº
      If IsNumeric(Y(x)(5)) Then
      '¡ô¦pªG§PÂ_¦r¨å¤¤¦r¨åªº ²Ä5­Óitem ªº¸ê®Æ¬O¼Æ¦r?
         V = V + Y(x)(5)
         '¡ôª÷ÃB²Ö¥[
      End If
   End If
Next
B.UsedRange.EntireRow.Delete
'¡ô§R°£ªí¤G ¦³¨Ï¥Îªº¦C
For R = 1 To x
'¡ô³]¶¶°j°é§â¦r¨å¤¤¦r¨åªºitem¨Ì§Ç±a¥X¨Ó©ñ¤Jªí¤GÀx¦s®æ¤¤
   For C = 1 To 5
      B.Cells(R, C) = Y(R)(C)
   Next
Next
x = x + 1
'¡ô¾Q³¯ Á`­p ¦Cªº¦C¼Æ
B.Cells(x, 1) = "Á`­p"
'¡ô"Á`­p"¦r¦ê©ñ¨ì«ü©wÀx¦s¦ì¸m
B.Cells(x, 5) = V
'¡ôª÷ÃB©ñ¨ì«ü©wÀx¦s¦ì¸m
B.Range(B.Cells(x, 1), B.Cells(x, 5)).Interior.ColorIndex = 6
'¡ôªí¤GªºÁ`­p¨º5®æ©³¦â§ï¬° ¶À¦â6

333
Set Y = Nothing
Set Brr = Nothing
End Sub

TOP

§Ö³t±N¦r¨åkeyµ²ªGªí¦C¸¹! item¬°«ü¤Þ¸ê®Æªíªº¦C¸¹
¤ß±oµù¸Ñ¦p¤U!½Ð¦U¦ì«e½ú«ü¥¿¨Ã«ü¾É! ÁÂÁÂ
Sub TEST_3()
Dim Brr, i&, T(5), TT, V&, Y, Z, x, C
Dim A, B
'¡ô«Å§iÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OY¬°¦r¨å
Set A = Sheets(1)
'¡ô¥OA¬O²Ä¤@­Ó¤u§@ªí
Set B = Sheets(2)
'¡ô¥OA¬O²Ä¤G­Ó¤u§@ªí
Brr = A.[A1].CurrentRegion
'¡ô¥OBrr¬O°}¦C,­Ë¤Jªí¤@[A1]³s±µ¨ìªºÀx¦s®æ
',ÂX®i¦Ü³Ì¤p¤è¥¿°Ï°ìÀx¦s­Óªº­È
For i = 1 To UBound(Brr)
'¡ô³]¶¶°j°é±N²Å¦X±ø¥óªº¦C­Ë¤JY¦r¨å¸Ì
   If Brr(i, 4) <> "" Then
   '¡ô¦pªG¼Æ¶qÄ椣¬OªÅ®æ??
      TT = Brr(i, 1) & "|" & Brr(i, 2)
      '¡ô¥OTT¬O ¼tµP&"|"&³W®æªº²Õ¦X¦r¦ê
      If Y.Exists(TT) Then
      '¡ô¦pªG§PÂ_Y¦r¨å¸Ì¦³¸ê®Æ?
         MsgBox i & " ¦C¼tµP+³W®æ ¦³­«½Æ!¤£¤¹³\°õ¦æ"
         '¡ô¦]¬°«á¾Ç³]©wªº±¡¹Ò ¼tµP+³W®æ ¤£­«½Æ,´N¸Ó¦³Àˬd¾÷¨î
         '§_«h¼Æ¶q·|¥u§ì³Ì«á¤@µ§,¦Ó¦X­p­È«o¤w²Ö¥[ª÷ÃB
         GoTo 333
      End If
      x = x + 1
      '¡ô²Å¦X±ø¥ó!´N¶}©l¾Q³¯ ¦r¨åªºKey¬O¥¼¨Óªº¦C¸¹!²Ö¥[1
      Y(x) = i
      '¡ôÅý¦r¨åªºKey¬O¥¼¨Óµ²ªGªíªº¦C¸¹,item¬O¸ê®Æªíªº¦C¸¹
      Y(TT) = 1
      '¡ô³o¬O²K¶i¥h¦r¨åµ¹¤U¤@½ü°j°é§P©w­«½Æ¥Îªº
      If IsNumeric(Brr(i, 5)) Then
      '¡ô¦pªG§PÂ_°}¦C¤¤ªº ²Ä5Äæ ªº¸ê®Æ¬O¼Æ¦r?
         V = V + Brr(i, 5)
         '¡ôª÷ÃB²Ö¥[
      End If
   End If
Next
B.UsedRange.EntireRow.Delete
'¡ô§R°£ªí¤G ¦³¨Ï¥Îªº¦C
For R = 1 To x
'¡ô³]¶¶°j°é§âY¦r¨å¤¤ªºitem ¸ê®Æªí¦C¸¹¨Ì§Ç±a¥XÀx¦s®æ¨Ó©ñ¤Jªí¤GÀx¦s®æ¤¤
   For C = 1 To 5
      B.Cells(R, C) = Brr(Y(R), C)
   Next
Next
x = x + 1
'¡ô¾Q³¯ Á`­p ¦Cªº¦C¼Æ
B.Cells(x, 1) = "Á`­p"
'¡ô"Á`­p"¦r¦ê©ñ¨ì«ü©wÀx¦s¦ì¸m
B.Cells(x, 5) = V
'¡ôª÷ÃB©ñ¨ì«ü©wÀx¦s¦ì¸m
B.Range(B.Cells(x, 1), B.Cells(x, 5)).Interior.ColorIndex = 6
'¡ôªí¤GªºÁ`­p¨º5®æ©³¦â§ï¬° ¶À¦â6

333
Set Y = Nothing
Set Brr = Nothing
End Sub

TOP

½Æ²ß  Union()
¥H¤U¬O½m²ß¤ß±oµù¸Ñ!
½Ð¦U¦ì«e½ú«ü¥¿¨Ã«ü¾É!ÁÂÁÂ

Option Explicit
Sub TEST_4()
Dim Arr As Range, i&, x, V
Dim A, B
'¡ô«Å§iÅܼÆ
Set A = Sheets(1)
'¡ô¥OA¬O²Ä¤@­Ó¤u§@ªí
Set B = Sheets(2)
'¡ô¥OA¬O²Ä¤G­Ó¤u§@ªí
Set Arr = A.[A1].Resize(1, 5)
'¡ô¥ýArr¬O¼Ð¦CÀx¦s®æ
x = 1
'¡ô¶}©l­p¼Æµ²ªGªí¦C¼Æ
For i = 2 To A.Cells(Rows.Count, 1).End(3).Row
'¡ô³]¶¶°j°é±N²Å¦X±ø¥óªº¦C¥[¤JArrÀx¦s®æ¶°¸Ì
   If A.Cells(i, 4) <> "" Then
   '¡ô¦pªG¼Æ¶qÄ椣¬OªÅ®æ??
      x = x + 1
      Set Arr = Union(Arr, A.Cells(i, 1).Resize(1, 5))
      '¡ô¥H¼ÐÃD¦C²Ö¥[²Å¦X±ø¥óªºÀx¦s®æ!¨S¦³Âo ¼tµP+³W®æ­«½Æªº
      V = V + A.Cells(i, 5)
      '¡ôª÷ÃB²Ö¥[
   End If
Next
B.UsedRange.EntireRow.Delete
'¡ô§R°£ªí¤G ¦³¨Ï¥Îªº¦C
Arr.Copy B.[A1]
'±NArrÀx¦s®æ¶° ½Æ»s¨ìµ²ªGªí
x = x + 1
'¡ô¾Q³¯ Á`­p ¦Cªº¦C¼Æ
B.Cells(x, 1) = "Á`­p"
'¡ô"Á`­p"¦r¦ê©ñ¨ì«ü©wÀx¦s¦ì¸m
B.Cells(x, 5) = V
'¡ôª÷ÃB©ñ¨ì«ü©wÀx¦s¦ì¸m
B.Range(B.Cells(x, 1), B.Cells(x, 5)).Interior.ColorIndex = 6
'¡ôªí¤GªºÁ`­p¨º5®æ©³¦â§ï¬° ¶À¦â6
End Sub

TOP

        ÀR«ä¦Û¦b : ¤H¥Í³Ì¤jªº¦¨´N¬O±q¥¢±Ñ¤¤¯¸°_¨Ó¡C
ªð¦^¦Cªí ¤W¤@¥DÃD