¦U¦ì¤j­ô¦n½Ð°Ý¤@­Óªí³æÂà´«¥¨¶°°ÝÃD

lionliu

¦U¦ì¤j­ô¦n:
§Ú¤Í¦³­Óªí³æÂà´«ªº¥¨¶°°ÝÃD¡A¤£ª¾¿ù¦b­þ¸Ì¡C
ªþ¤W§Úªº¥¨¶°ÀÉ¡A§Ú·QÅýsheet(1)Âà´«sheet(3)¡C
¬¡­¶Ã¯2.rar (11.64 KB)

¤U¸ü¦¸¼Æ: 6

2015-9-19 11:50

GBKEE

¦^´_ 1# lionliu

1. L = 1
   
2.         Do Until Sheets(1).Cells(i, "d") = "" And Sheets(1).Cells(i, "b") <> Empty
   
3.             '³]©wªº§PÂ_¦¡¬°True®É"   Â÷¶}  Do Loop °j°é
   
4.             'ÅÜ¼Æ i ¦b°j°é¤¤¤@ª½¨SÅܰʪº,©Ò¥H¶i¤J°j°é«á¶]¤£§¹¤F.
   
5.             Sheets(2).Cells(k, "b").Offset(L - 1) = Sheets(1).Cells(k, "b").Offset(L)
   
6.             L = L + 1  '
   
7.         Loop

½Æ»s¥N½X

¥Î§R°£

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Rng As Range, i As Integer
   
4.     With Sheets("PKG").UsedRange.Columns("a:g").Rows '³o½d³òªºRows(¦Cªºª«¥ó¶°¦X)
   
5.         For i = 2 To .Count                          '¥Ñ²Ä2¦C¶}©l
   
6.             If Application.CountA(.Rows(i)) = .Columns.Count Then   '¦C¤¤ªºÀx¦s®æ³£¦³¸ê®Æ            '
   
7.                 .Rows(i).Cells(1, 2) = .Rows(i + 1).Cells(1, 2)     '
   
8.                 If Rng Is Nothing Then                              '½d³ò«ü©w¨ìÅܼƤ¤
   
9.                     Set Rng = .Rows(i + 1)
   
10.                 Else
    
11.                     Set Rng = Union(Rng, .Rows(i + 1))              'Union ¤èªk: ¶Ç¦^¨â­Ó©Î¦h­Ó½d³òªº¦X¨Ö½d³ò¡C
    
12.                 End If
    
13.             End If
    
14.         Next
    
15.         If Not Rng Is Nothing Then Rng.Delete                        '§R°£
    
16.     End With
    
17. End Sub

½Æ»s¥N½X

­ã´£³¡ªL

°²¦p¸ê®Æ³o»ò¦³³W«h¡D°Ñ¦Ò¡G

1. Sub Macro1()
   
2. Dim xU As Range
   
3. Sheets("PKG").UsedRange.Copy [¤u§@ªí2!A1] '¶K¤J¥þ³¡¸ê®Æ
   
4. Set xU = [¤u§@ªí2!D:D].SpecialCells(xlCellTypeConstants, 2) '¨ú±o"PC"¦r¼Ë¥þ³¡Àx¦s®æ
   
5. xU.Offset(1, -3).ClearContents '²M°£[½c¸¹]¤U¤è¼Æ¦r
   
6. With xU.Offset(, -2)
   
7. ¡@¡@¡@.Item(1).Delete Shift:=xlUp 'BÄæ¤W²¾¤@®æ
   
8. ¡@¡@¡@.EntireRow.Delete '§R¥h¦C
   
9. End With
   
10. End Sub

½Æ»s¥N½X

©Î¡G

1. Sub Macro2()
   
2. Sheets("PKG").UsedRange.Copy [¤u§@ªí2!A1]
   
3. With [¤u§@ªí2!D:D].SpecialCells(xlCellTypeConstants, 2).Offset(, -2)
   
4. ¡@¡@¡@.Offset(1, -1).ClearContents '²M°£[½c¸¹]¤U¤è¼Æ¦r
   
5. ¡@¡@¡@.Item(1).Delete Shift:=xlUp 'BÄæ¤W²¾¤@®æ
   
6. ¡@¡@¡@.EntireRow.Delete '§R¥h¦C
   
7. End With
   
8. End Sub

½Æ»s¥N½X

lionliu

¦^´_ 2# GBKEE
ÁÂÁ¨â¦ì¤j­ô¦^ÂСA²{¶i¦æ´ú¸Õ¡C