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

vba¤ñ¹ï¨â¥÷¸ê®Æ¬O§_¤@¼Ë¦C¥X®t²§

vba¤ñ¹ï¨â¥÷¸ê®Æ¬O§_¤@¼Ë¦C¥X®t²§

­Ó¦ì¤j¯«½Ð±Ð¤@¤U,§Ú·Q­n¤ñ¹ï¨â¥÷¸ê®Æ¬O§_¤@¼Ë,¦C¥X®t²§³¡¥÷,vba¦p¦ó°µ Excel¤ñ¹ï¸ê®Æ.rar (10.55 KB)

ÁÂÁ¤À¨É¡I
¾Ç²ß«Ü¦h¡A¤×¨äandyÁÙÀ°¦£¼g¤Fµù¸Ñ

TOP

ÁÂÁÂÁÙ³o»ò¥Î¤ß¡B¸Ô²Óªºµù¸Ñ¡AÁÙ¦³ªþ¥[»¡©ú¡A·PÁ¡C
¦¹Åý¾Ç¥Í¾Ç²ß¤F«Ü¦h¡A§ó²M·¡ªº¤F¸Ñ¥Îªk¡C

TOP

¦^´_ 38# aassddff736

ÁÂÁ½׾Â,ÁÂÁ«e½ú¤W½×¾Â¤@°_¾Ç²ß
«á¾Ç½Æ²ß¤F¤@¤U¨Ã§@µù¸Ñ,¶K¤W¨Ó½Ð«e½ú°Ñ¦Ò,½Ð¦U¦ì«e½ú«ü±Ð

Option Explicit
Private Sub CommandButton1_Click()
Dim Arr, Brr, Crr, C%, Z, N&, i&, j%, R&, Ta$, Tb$, xR As Range, xB As Range, xS As Worksheet
'¡ô«Å§iÅܼÆ,%¬Oµu¾ã¼Æ,&¬Oªø¾ã¼Æ,$¬O¦r¦êÅܼÆ,As Range¬OÀx¦s®æÅܼÆ,As Worksheet¬O¤u§@ªíÅܼÆ,¨ä¥¦¨S¦³«ü©wªº¬O³q¥Î«¬ÅܼÆ
Set Z = CreateObject("Scripting.Dictionary"): Set xS = Sheets("¤ñ¹ïµ²ªG")
'¡ô¥OZÅܼƬO¦r¨å,¥OxSÅܼƬO¤u§@ªí("¤ñ¹ïµ²ªG")
Set Arr = Sheets("¸ê®ÆA").[A1].CurrentRegion: Arr = Union(Arr, Arr.Offset(, 1))
'¡ô¥OArrÅܼƬO¤u§@ªí("¸ê®ÆA").[A1]Àx¦s®æ¬Û¾F¦êÁp«áÂX®i¦¨ªº³Ì¤p¤è¥¿°Ï°ìÀx¦s®æ
'¥OArrÅܼÆÅܨ­¬°¤Gºû°}¦C (Áp¶°¦Û¨­°Ï°ì©¹¥k°¾²¾1Äæ«áªº°Ï°ìÀx¦s®æ­È±a¤J°}¦C¤¤)

Set Brr = Sheets("¸ê®ÆB").[A1].CurrentRegion: Brr = Union(Brr, Brr.Offset(, 1))
'¡ô¥OBrrÅܼƬO¤u§@ªí("¸ê®ÆA").[A1]Àx¦s®æ¬Û¾F¦êÁp«áÂX®i¦¨ªº³Ì¤p¤è¥¿°Ï°ìÀx¦s®æ
'¥OBrrÅܼÆÅܨ­¬°¤Gºû°}¦C (Áp¶°¦Û¨­°Ï°ì©¹¥k°¾²¾1Äæ«áªº°Ï°ìÀx¦s®æ­È±a¤J°}¦C¤¤)

C = UBound(Arr, 2): If C <> UBound(Brr, 2) Then [B6:B8] = "": [B9] = 0: [B10] = 0: MsgBox "Äæ¼Æ¤£¦P": Exit Sub
'¡ô¥OCÅܼƬOArr°}¦C³Ì¤j¯Á¤ÞÄ渹
'¦pªGCÅܼƤ£¦P©óBrr°}¦C³Ì¤j¯Á¤ÞÄ渹!´N¥O[B6:B8]Àx¦s®æ­È¬O ªÅ¦r¤¸:¥O[B9]¬O0,¥O[B10]¬O0,³Ì«á¸õ¥X´£µøµ¡~~~,µ²§ôµ{¦¡°õ¦æ

ReDim Crr(1 To (UBound(Arr) + UBound(Brr)), 1 To C * 2 + 1)
'¡ô«Å§iCrrÅܼƬO¤Gºû°}¦C,Áa¦V½d³ò±q1 ¨ì(Arr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹+Brr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹),¾î¦V½d³ò±q1 ¨ì(CÅܼÆ*2+1)
For i = 1 To UBound(Arr)
'¡ô³]¶¶°j°é!i±q1 ¨ìArr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
   Ta = Trim(Arr(i, 1)): R = R + 1: Z(Ta) = R: Crr(R, 1) = Ta
   '¡ô¥OTa³o¦r¦êÅܼƬO i°j°é¦C1ÄæArr°}¦C­È¥h°£ÀY§ÀªÅ¥Õ¦r¤¸«áªº·s¦r¦ê,¥ORÅܼƲ֥[1
   '¥O¥HTaÅܼƬ°key,RÅܼƬ°item¯Ç¤JZ¦r¨å¤¤:¥ORÅܼƦC1ÄæCrr°}¦C­È¬O TaÅܼÆ

   For j = 1 To C: Crr(R, j + 1) = Arr(i, j): Next
   '¡ô³]¶¶°j°é!j±q1 ¨ìÅܼÆC: ¥ORÅܼƦC(j+1)ÄæCrr°}¦C­È¬O i°j°é¦Cj°j°éÄæArr°}¦C­È
Next
For i = 1 To UBound(Brr)
'¡ô³]¶¶°j°é!i±q1 ¨ìBrr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
   Tb = Trim(Brr(i, 1)): N = Z(Tb): If N = 0 Then R = R + 1: Crr(R, 1) = Tb: N = R: Z(Tb) = R
   '¡ô¥OTb³o¦r¦êÅܼƬO i°j°é¦C1ÄæBrr°}¦C­È¥h°£ÀY§ÀªÅ¥Õ¦r¤¸«áªº·s¦r¦ê,¥ON³oªø¾ã¼ÆÅܼƬO¥HTbÅܼƬ°key¬dZ¦r¨å¦^¶Ç­È(item)
   '¦pªGNÅܼƬO 0,´N¥ORÅܼƲ֥[1:¥ORÅܼƦC1ÄæCrr°}¦C­È¬O TbÅܼÆ,¥ONÅܼÆ=RÅܼÆ,¥O¥HTbÅܼƬ°key,RÅܼƬ°item¯Ç¤JZ¦r¨å¤¤
   For j = 1 To C: Crr(N, j + 1 + C) = Brr(i, j): Next
   '¡ô³]¶¶°j°é!j±q1 ¨ìÅܼÆC: ¥ONÅܼƦC(j+1+C)ÄæCrr°}¦C­È¬O i°j°é¦Cj°j°éÄæBrr°}¦C­È
Next
Application.Goto xS.[A1]
'¡ô¥O´å¼Ð¸õ¨ìxSÅܼƪº[A1]Àx¦s®æ¦ì¸m
xS.UsedRange.EntireRow.Delete: xS.[A1] = "NUMBER"
'¡ô¥OxSÅܼƸ̦³¨Ï¥ÎÀx¦s®æ©Ò¦bªº¦C§R°£,¥OxSÅܼƪº[A1]Àx¦s®æ­È¬O¦r¦ê "NUMBER"
With xS.[A2].Resize(R, C * 2 + 1): .Value = Crr: .Sort KEY1:=.Item(1), Order1:=1, Header:=2: Crr = .Value: End With
'¡ô¥OxSÅܼƸÌ[A2]Àx¦s®æÂX®i­è¦nªº°Ï°ì¥HCrr°}¦C­È±a¤J,¨Ã¥O¥H¸Ó°Ï°ìÀx¦s®æ¥H²Ä1Ä欰°ò·Ç°µ¨S¦³¼ÐÃD¦Cªº¶¶±Æ§Ç
xS.[B1] = [B2]: xS.[B1].Resize(, C - 1).Merge: xS.[B1].Interior.Color = [B2].Interior.Color
'¡ô¥OxSÅܼƸÌ[B1]Àx¦s®æ­È¦P ¥»ªí[B2]Àx¦s®æ­È,¥O¼ÐÃD¦CÀx¦s®æ¦X¨Ö,¥O¸Ó¼ÐÃD¦CÀx¦s®æ©³¦â¦P ¥»ªí[B2]Àx¦s®æ©³¦â
xS.[B1].Item(, C + 1) = [B3]: xS.[B1].Item(, C + 1).Resize(, C - 1).Merge: xS.[B1].Item(, C + 1).Interior.Color = [B3].Interior.Color
'¡ô¥OxSÅܼƸÌ[B1]¦Û¨­¶}©l©¹¥kC+1ÄæÀx¦s®æ­È¦P ¥»ªí[B3]Àx¦s®æ­È
'¥O¼ÐÃD¦CÀx¦s®æ¦X¨Ö,¥O¸Ó¼ÐÃD¦CÀx¦s®æ©³¦â¦P ¥»ªí[B3]Àx¦s®æ©³¦â

xS.UsedRange.EntireColumn.AutoFit: Set xR = xS.UsedRange: Set xR = xR(xR.Count + 1): Set xB = xR: xS.[1:1].HorizontalAlignment = xlCenter
'¡ô¥OxSÅܼƸ̦³¨Ï¥ÎÀx¦s®æ©Ò¦bÄæ¦ì¦Û°Ê½Õ¾ãÄæ¼e,¥OxRÅܼƬO xSÅܼƸ̦³¨Ï¥ÎÀx¦s®æ: ¥OxRÅܼƬO¨S¨Ï¥Îªº¦a1­ÓÀx¦s®æ
'¥OxBÅܼƬO¦PxRÅܼÆ(Àx¦s®æ):¥OxSÅܼƸ̲Ä1¦CÀx¦s®æ®æ¦¡ ¤ô¥­¤å¦r¸m¤¤

For i = 2 To R + 1
'¡ô³]¶¶°j°é!i±q2 ¨ìRÅܼÆ+1
   For j = 2 To C
   '¡ô³]¶¶°j°é!j±q2 ¨ìCÅܼÆ
      Set xR = IIf(Crr(i - 1, j) <> Crr(i - 1, j + C), Union(xR, xS.Cells(i, j), xS.Cells(i, 1)), xR)
      '¡ô¥O¨â°Ï°ì¬Û¹ïÄæ¦ìÀx¦s®æ­È¦pªG¤£¦P!´N±N¥ª°ÏÀx¦s®æ»PAÄæÀx¦s®æ ¯Ç¤JxRÅܼƤ¤
      If Crr(i - 1, j) = "" Or Crr(i - 1, j + C) = "" Then Set xB = Union(xB, xS.Cells(i, j))
      '¡ô¥O¨â°Ï°ì¬Û¹ïÄæ¦ìÀx¦s®æ­È¦pªG¬OªÅ®æ!´N±N¥ª°ÏÀx¦s®æ ¯Ç¤JxBÅܼƤ¤
   Next
Next
Union(xR, xR.Offset(, C)).Font.ColorIndex = 3
'¡ô¥O¨â°Ï°ì¤ñ¹ï¥X¤£¦PªºÀx¦s®æ ³s¦PAÄæÀx¦s®æxRÅܼƦr¦âÅܬ°¬õ¦â
xB.EntireRow.Font.ColorIndex = 5
'¡ô¥OxBÅܼƩҦb¦C¾ã¦C¦r¦âÅܬ°ÂŦâ
With Sheets("¯d¤U¬Û¦P")
'¡ô¥H¤U¬OÃö©ó¤u§@ªí("¯d¤U¬Û¦P")ªºµ{§Ç
   .UsedRange.EntireRow.Delete: xS.UsedRange.Copy .[A1]: .UsedRange.EntireColumn.AutoFit
   '¡ô¥O¸Óªí¦³¨Ï¥ÎÀx¦s®æ©Ò¦bªº¾ã¦C§R°£: ¥OxSÅܼƦ³¨Ï¥ÎÀx¦s®æ½Æ»s¨ì¸Óªí[A1]: ¥O¸Óªí¦³¨Ï¥ÎÀx¦s®æ©Ò¦bÄæ¦Û°Ê½Õ¾ãÄæ¼e
   .Range(Intersect(xR.EntireRow, xS.UsedRange).Address).EntireRow.Delete
   '¡ô¥O¦³®t²§ªº¦C¾ã¦C§R°£
End With
With Sheets("¯d¤U®t²§")
'¡ô¥H¤U¬OÃö©ó¤u§@ªí("¯d¤U®t²§")ªºµ{§Ç
   .UsedRange.EntireRow.Delete: Intersect(Union(xS.[A1], xR.EntireRow), xS.UsedRange).EntireRow.Copy .[A1]: .UsedRange.EntireColumn.AutoFit
   '¡ô¥O¸Óªí¦³¨Ï¥ÎÀx¦s®æ©Ò¦bªº¾ã¦C§R°£: ¥OxSÅܼƦ³®t²§ªº¦C¾ã¦C½Æ»s¨ì¸Óªí[A1]: ¥O¸Óªí¦³¨Ï¥ÎÀx¦s®æ©Ò¦bÄæ¦Û°Ê½Õ¾ãÄæ¼e
End With
[B6] = C - 1: [B7] = UBound(Arr): [B8] = UBound(Brr): [B9] = 1: [B10] = 1
'¡ô¥O¥»ªí[B6]­È¬O CÅܼÆ-1: ¥O[B7]­È¬OArr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹: ¥O[B8]­È¬OBrr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 36# Andy2483


ÁÂÁ¤j¯«

¤£¦n·N«ä¬Ý¿ù ¦^´_
³o­Ó§ó§ï«áFor j = 2 To C ¥i¥H¤F

«D±`«D±`°ª¿³ ÁÂÁ¤j¯«ªºÀ°¦£

TOP

¦^´_ 10# Andy2483
      ¦­¦w!¤j¯«
     §Ú§ï³o­Ó Sort KEY1:=.Item(1) ¤@¼Ë"¯d¤U®t²§"¨S¸ê®Æ
   

TOP

¦^´_ 35# aassddff736

±N For j = 3 To C §ï¬° For j = 2 To C
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 13# Andy2483
«¢¹Æ¤j¯« ¥i¥HÀ°§Ú¬Ý¬Ý
¬°¤°»ò §Ú¤ñ¹ï¸ê®Æ¥u¦³¤@¦æ®É ®t²§¸ê®Æ¨S¨q¥X¨Ó
Excel¤ñ¹ï­ì©l¸ê®Æ.rar (54.49 KB)

TOP

¦^´_ 30# Andy2483

ÁÂÁ«ü¾É! ¯uªº«Ü¬O·PÁ±zÀ°¦£¸Ñµª
§Ú¦³¶R®Ñ¦Û²ß ¦ý¬OÁÙ¬O¤p¥Õ

TOP

¦^´_ 32# aassddff736


    Åý·s¤u§@ªí¦W¤£­n¹H¤Ï¦¹³W«h
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¨ü¤HÂI¤ô¤§®¦¡A¶··í´é¬u¥H³ø¡C
ªð¦^¦Cªí ¤W¤@¥DÃD