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

½Ð±Ð·j´M¦WºÙ¡@§ä¥X¤é´Á¡@ÁÂÁÂ

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«¾Ç²ß«e½úªº¤è®×,Åܧ󤣦P»Ý¨D±¡¹Ò,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

ªí1 ¸ê®Æªí:


­ã´£³¡ªL«e½úªººë²¤è®×°õ¦æµ²ªG:


«á¾Ç¤è®×°õ¦æµ²ªG:



Option Explicit
Sub TEST()
Dim Brr, Crr, i&, j%, R&, Y&, X%, T$
Dim xR As Range, Sh1 As Worksheet, Sh2 As Worksheet
'¡ô«Å§iÅܼÆ
Set Sh1 = Sheets("¤u§@ªí1"): Set Sh2 = Sheets("¤u§@ªí2")
'¡ô¥OÅܼƲ±¸Ëª«¥ó(¤u§@ªí)
Sh2.UsedRange.ClearContents
'¡ô¥Oªí2¦³¨Ï¥ÎÀx¦s®æ²M°£¤º®e
Brr = Range(Sh1.[H1], Sh1.Cells(Rows.Count, "A").End(xlUp))
'¡ô¥OBrrÅܼƬO¤Gºû°}¦C,¥Hªí1ªºA~HÄæ°}¦C­È±a¤J°}¦C¤¤
Y = UBound(Brr): X = UBound(Brr, 2)
'¡ô¥OYÅܼƬO Brr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹,¥OXÅܼƬO Brr°}¦C¾î¦V³Ì¤j¯Á¤ÞÄ渹
ReDim Crr(1 To Y, 1 To 2)
'¡ô¥OCrrÅܼƬO ¤GºûªÅ°}¦C,Áa¦V½d³ò¦PBrr°}¦C,¾î¦V1~2Äæ
For i = 6 To Y
'¡ô³]¶¶°j°é
   If i = 6 Then
      Crr(1, 1) = "¤é´Á"
      Crr(1, 2) = "¬I¤u¶µ¥Ø"
      R = 1
   End If
   '¡ô¦pªGiÅܼƬO1,¥ý³B²z¼ÐÃD¦C
   If Not IsDate(Brr(i, 1)) Then
   '¡ô¦pªGBrr°}¦C¼ÐÃDÄæ(¤é´ÁÄæ)¸Ìªº­È¤£¬O¤é´Á?
      MsgBox Brr(i, 1) & " ¬O¿ù»~ªº¤é´Á!½Ð­×¥¿«á¦A­«·s°õ¦æ"
      '¡ô¸õ¥X´£¥Üµ¡ "~~~"
      Exit Sub
      '¡ôµ²§ôµ{¦¡°õ¦æ
   End If
   For j = 2 To X
      If Val(Brr(i, j)) > 0 Then T = T & "¡B" & Brr(1, j)
   Next
   '¡ô³]¶¶°j°é,±N¦P¦C¦UÄæ¬O¼Æ­Èªº¼ÐÃD¥H¹y¸¹¶¡¹j
   R = R + 1
   '¡ô¥ORÅܼƲ֥[1
   Crr(R, 1) = Brr(i, 1)
   If T <> "" Then
   '¡ô¦pªGTÅܼƤ£¬OªÅªº?
      Crr(R, 2) = Mid(T, 2)
      '¡ô¥OCrr°}¦C²Ä2Äæ¼g¤J¬I¤u¶µ¥Ø¶°¦r¦ê
      T = ""
      '¡ô¥OTÅܼƲM°£¤º®e
   End If
i01: Next
Sh2.[A1].Resize(R, 2) = Crr
'¡ô¥Oªí2.[A1]ÂX®i½d³òÀx¦s®æ­È¥HCrr°}¦C­È¼g¤J
Application.Goto Sh2.[A1]
'¡ô¥O´å¼Ð¸õ¨ìªí2.[A1]Àx¦s®æ
Set Sh1 = Nothing: Set Sh2 = Nothing: Erase Brr, Crr
'¡ô¥OÄÀ©ñÅܼÆ
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¤f»¡¦n¸Ü¡B¤ß·Q¦n·N¡B¨­¦æ¦n¨Æ¡C
ªð¦^¦Cªí ¤W¤@¥DÃD