- ©«¤l
- 1446
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1470
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-10-21
|
¦^´_ 7# Andy2483
½Æ²ß,×¥¿»Pµù¸Ñ
Option Explicit
Sub ¥[¤J¥Dªí®æ()
Dim Crr(1 To 100, 1 To 6), Q, i&, j%, A, n&
'¡ô«Å§iCrrÅܼƬO¤Gºû°}¦CÁa¦V½d³ò1¨ì 100,¾î¦V½d³ò±q1¨ì 6
'(Q,A)¬O³q¥Î«¬ÅܼÆ,(i,n)¬Oªø¾ã¼Æ,j¬Oµu¾ã¼Æ
Dim sh1 As Worksheet, sh2 As Worksheet, Frng As Range
'¡ô«Å§i(sh1,sh2)¬O¤u§@ªíÅܼÆ,Frng¬OÀx¦s®æÅܼÆ
For Each Q In Worksheets
'¡ô³]³v¶µ°j°é!¥OQ¬O¬¡¶Ã¯¤¤ªº¤u§@ªí
If Q.[F1] = "«Øij¼tµP" Then Set sh1 = Q
'¡ô¦pªG¤u§@ªí¤¤ªº[F1]Àx¦s®æȬO"«Øij¼tµP"!´N¥Osh1ÅܼƬO¤u§@ªíQ
If Q.[G3] = "«Øij¼tµP" Then Set sh2 = Q
'¡ô¦pªG¤u§@ªí¤¤ªº[G3]Àx¦s®æȬO"«Øij¼tµP"!´N¥Osh2ÅܼƬO¤u§@ªíQ
Next
A = Array(1, 2, 4, 5, 6)
'¡ô¥OAÅܼƬO¤@ºû°}¦C,0~4¯Á¤Þ¸¹°}¦CȨ̧ǬO(1, 2, 4, 5, 6)
With sh1: .Activate
'¡ô¥H¤U¬OÃö©ó¤u§@ªísh1ªºµ{§Ç
'¡ô¥O¿E¬¡¸Ó¤u§@ªí
If .AutoFilter Is Nothing Then
'¡ô¦pªG¤u§@ªí¨S¦³¿z¿ïªº¥\¯à?
.[A2].AutoFilter
'¡ô¥O¸Óªí±q¸Óªí[A2]Àx¦s®æ«Ø¥ß¿z¿ï¥\¯à
With ActiveWindow
'¡ô¥H¤U¬OÃö©óµøµ¡ªºµ{§Ç
.FreezePanes = False: .SplitRow = 1: .FreezePanes = True
'¡ô¥Oáµ²µøµ¡¸Ñ°£,²Ä1¦C¤À³Îµøµ¡:¥Oáµ²µøµ¡
End With
End If
If .[B65536].End(3).Row = 1 Then MsgBox "¨S¦³¸ê®Æ": Exit Sub
'¡ô¦pªG¸ÓªíBÄæ³Ì«á¦³¤º®eÀx¦s®æ¦C¸¹¬O1? True´N¸õ¥X´£µøµ¡,µ²§ôµ{¦¡°õ¦æ
For i = 2 To .[B65536].End(3).Row
'¡ô³]¶¶°j°é!i±q2¨ì¸ÓªíBÄæ³Ì«á¦³¤º®eÀx¦s®æ¦C¸¹
If .Rows(i).EntireRow.Hidden = True Then GoTo i02
'¡ô¦pªG¸Ó¦C¬OÁôÂêº!´N¸õ¨ì¼Ð¥Üi02¦ì¸mÄ~Äò°õ¦æ
n = n + 1
'¡ô¥OnÅܼƲ֥[1
For j = 0 To 4
'¡ô³]¶¶°j°é!j±q0¨ì 4
Crr(n, A(j)) = Cells(i, j + 2)
'¡ô¥OnÅܼƦC(jÅܼÆA°}¦CÈ)Ä檺Crr°}¦CȬOiÅܼƦCjÅܼÆ+2ÄæÀx¦s®æÈ
Next
i02: Next
End With
With sh2.[B65536].End(3)(2).Resize(n, 6)
'¡ô¥H¤U¬OÃö©ó¤u§@ªísh2±q¤U©¹¤W§ä¨ìªºBÄæ²Ä1Ӫťծæ¦V¤UÂX®inÅܼƦC,
'¦V¥kÂX®i6ÄæÀx¦s®æªºµ{§Ç
.Value = Crr
'¡ô¥OÀx¦s®æÈ¥HCrr°}¦Cȱa¤J
sh2.Activate
'¡ô¥O¿E¬¡¤u§@ªí
.Select
'¡ô¥O¿ï¨ú¸Ó½d³òÀx¦s®æ
End With
Set sh1 = Nothing: Set sh2 = Nothing: Set Frng = Nothing: Erase Crr
'¡ô¥OÄÀ©ñÅܼÆ
End Sub
Sub ²M°£¶µ¥Ø()
Dim Q
For Each Q In Worksheets
If Q.[G3] = "«Øij¼tµP" Then Q.UsedRange.Offset(3, 0).EntireRow.Delete: Exit Sub
Next
'¡ô¥Oµ²ªGªí²M°£²Ä3¦C¥H«áªº¸ê®Æ(§t)
End Sub |
|