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

[µo°Ý] VBA ·j´Mªº°ÝÃD

¦^´_ 3# sss1159


¡e¤u§@ªí¢°¡f
¦AÂI¿ï ¨ú®ø·j´M
§Y¥i«ì´_­ì¥»¥¼·j´M«eªº¸ê®Æ

¢Ï¡G¢ÒÄæ§Y¬O­ì¥»¸ê®Æ¡A·j´M¨Ã¥¼°Ê¨ì¦¹³¡¥÷¡A¦ó¨Ó¡e«ì´_­ì¥»¥¼·j´M«eªº¸ê®Æ¡f¡H¡H¡H

TOP

¦^´_ 6# sss1159


Sub ¿z¿ï()
Dim X$
X = Application.InputBox("½Ð¿é¤J¿z¿ïÃöÁä¦r")
If X = "" Or X = "False" Then Exit Sub
With Range([A3], Cells(Rows.Count, 1).End(xlUp))
     If .Offset(1, 0).Find(X, Lookat:=xlPart) Is Nothing Then MsgBox "§ä¤£¨ì¸ê®Æ!!": Exit Sub
    .AutoFilter Field:=1, Criteria1:="*" & X & "*"
End With
End Sub

'¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×¡×
Sub ¿z¿ï¸Ñ°£()
ActiveSheet.AutoFilterMode = False
End Sub

TOP

¡Õ¤u§@ªí¢±¡Ö¡@

Sub ·j´M()
Dim X$, R&, xSht As Worksheet, M, j&, Jm&, xH As Range
R = ActiveSheet.UsedRange.Rows.Count
If R > 3 Then Rows("4:" & R).Delete
X = Application.InputBox("½Ð¿é¤J·j´MÃöÁä¦r")
If X = "" Or X = "False" Then Exit Sub
For Each xSht In Sheets(Array("¤u§@ªí1", "¤u§@ªí3"))
¡@¡@Set xH = Range(Array("A4", "H4")(M))
¡@¡@M = M + 1: Jm = 0
¡@¡@With xSht
¡@¡@¡@¡@¡@For j = 4 To .Cells(Rows.Count, 1).End(xlUp).Row
¡@¡@¡@¡@¡@¡@¡@If InStr(.Cells(j, 1) & .Cells(j, 2), X) Then
¡@¡@¡@¡@¡@¡@¡@¡@¡@Jm = Jm + 1
¡@¡@¡@¡@¡@¡@¡@¡@¡@.Cells(j, 1).Resize(1, 4).Copy xH(Jm)
¡@¡@¡@¡@¡@¡@¡@End If
¡@¡@¡@¡@¡@Next j
¡@¡@¡@¡@¡@If Jm = 0 Then MsgBox "¡e" & .Name & "¡f§ä¤£¨ì¡e" & X & "¡f¬ÛÃö¸ê®Æ!!":
¡@¡@End With
Next
End Sub

TOP

¥»©«³Ì«á¥Ñ ­ã´£³¡ªL ©ó 2015-11-10 09:59 ½s¿è

¦^´_ 9# sss1159


R = Range([A1], ActiveSheet.UsedRange).Rows.Count
¡Ä½Ð§ï¦¨¦p¤W¡A¥H¨¾¡e¼ÐÃD¦C¡f¥H¤W¥¼¨Ï¥Î¡AUsedRange·|¤£¥]²[³o½d³ò
If R > 3 Then Rows("4:" & R).Delete
¡Ä¡e¼ÐÃD¦C¡f¦b²Ä¢²¦C¡A­Y¶W¹L¢²¤~ªí¥Ü©³¤U¦³¸ê®Æ¡A¦A²MªÅ

¤j¤Zªí®æµ²ºc·|¦³¡eªí­º¡f¡e¼ÐÃD¦C¡f¡e¸ê®Æ©ú²Ó¡f¡A¬Ò¥H¡e¼ÐÃD¦C¡f¬°°Ï¹j½u

³o¬q¬O«ü­n¸ü¤J¬d¸ß¸ê®Æªº¤u§@ªí¡A¥ç§Y°õ¦ævbaªº¡e·í«e­¶¡f

TOP

¦^´_ 10# ­ã´£³¡ªL


For j = 4 To .Cells(Rows.Count, 1).End(xlUp).Row

¢³¬°¬d¸ß¸ê®Æ¡e¨Ó·½¡f¤u§@ªí¡e¸ê®Æ©ú²Ó¡fªº¡e°_©l¦C¡f¡A»P¤W¤èªº¢³¤£¬ÛÃö¡A
¤@­Ó¬O¬d¸ßªí¡A¤@­Ó¬O¸ê®Æªí¡A¥u¬O­è¦n³£±q²Ä¢³¦C¶}©l¡A
¡Ä¡Ä¤£¦P¤u§@ªí¥²¶·¦³©T©wªºªí®æµ²ºc¡A§_«h®e©ö¥X¿ù¡ã¡ã

¨ä¥¦¤j­P³£¹ï¡ã¡ã

TOP

¦^´_ 12# sss1159

±Æ§Çµ{¦¡½X³Ì¤W¤è¥[¤J¡G
ActiveSheet.AutoFilterMode = False

ª`·N¡G¿z¿ïª¬ºA®É¡A­Y¤£¥ý¸Ñ°£¿z¿ï¡A¥ô¦ó¾Þ§@³£¥i¯à³y¦¨µLªkÀ±¸Éªº¿ù»~¡]¤×¨ä¬O¤w°õ¦æ¤FÀx¦sµ²ªG¡^

TOP

¥»©«³Ì«á¥Ñ ­ã´£³¡ªL ©ó 2015-11-10 13:29 ½s¿è

¦^´_ 14# sss1159

Sub ±Æ§Ç()
Dim R&
R = [¤u§@ªí1!A1].Cells(Rows.Count, 1).End(xlUp).Row
If R < 4 Then Exit Sub
With [¤u§@ªí1!A3:E3].Resize(R - 2)
¡@¡@¡@.Select¡@'³o¥i¥H§R±¼¡@
¡@¡@¡@.Sort Key1:=.Item(5), Order1:=xlAscending, Header:=xlYes, _
¡@¡@¡@¡@¡@¡@OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
End Sub

.Item(5)¡@§Y¬O¢ÓÄ檺¼ÐÃD¡e·s¼W¤é´Á¡f¡I
¦A´£¿ô¡G¡e¿z¿ï¡fª¬ºA¤¤¡A¾¨¶q¤£°µ¡e±Æ§Ç¡f¡A¤]¤£±q¥¦³B¶K¸ê®Æ¶i¨Ó¡A·|³y¦¨¸ê®Æ¿ù¶Ã

TOP

¦^´_ 21# sss1159


OFFICE 2000 ¨S³o¥\¯à, À°¤£¤F~~

TOP

¦^´_ 21# sss1159


LRR = Array("®à²y", "¦Ð²y", "®à²y", "Äx²y") ¡@'±Æ§Ç²M³æ¡@
Application.AddCustomList ListArray:=LRR ¡@'«Ø¥ß²M³æ¡@
Lx = Application.GetCustomListNum(LRR) ¡@'¨ú±o²M³æ¦ì¸m§Ç¸¹¡@

With [¤u§@ªí1!A3:F3].Resize(R - 2)
     .Select
     .Sort Key1:=.Item(6), Order1:=xlAscending, Header:=xlYes, _
           OrderCustom:=Lx + 1, MatchCase:=False, Orientation:=xlTopToBottom
End With
¡@
¡@
°Ñ¦Ò§Y¥i¡A³o²M³æ±Æ§Ç¨Ï¥Îvba¼u©Ê¨Ã¤£¦n¡ã¡ã

TOP

¦^´_ 21# sss1159

³o¬O¸û§¹¾ãªº°µªk¡A²M³æ¤£¦s¦b¡A¦Û°Ê«Ø¥ß¡AÀH«á¦A§R±¼¡ã¡ã
¡@
Sub ±Æ§Ç()
Dim R&, LRR, Lm%, Lx%
R = [¤u§@ªí1!A1].Cells(Rows.Count, 1).End(xlUp).Row
If R < 4 Then Exit Sub
¡@
LRR = Split("ÂŲy_±Æ²y_´Î²y_¨¬²y_®à²y", "_") ¡@'±Æ§Ç²M³æ
With Application
¡@¡@¡@Lm = .GetCustomListNum(LRR) ¡@'Àˬd²M³æªº¦ì¸m
¡@¡@¡@If Lm = 0 Then .AddCustomList ListArray:=LRR ¡@'²M³æ¤£¦s¦b,«Ø¥ß
¡@¡@¡@Lx = .GetCustomListNum(LRR) ¡@'¨ú±o²M³æ¦ì¸m§Ç¸¹
End With
¡@
With [¤u§@ªí1!A3:F3].Resize(R - 2)
¡@¡@¡@.Select
¡@¡@¡@.Sort Key1:=.Item(6), Order1:=xlAscending, Header:=xlYes, _
¡@¡@¡@¡@¡@¡@OrderCustom:=Lx + 1, MatchCase:=False, Orientation:=xlTopToBottom
End With
¡@
If Lm = 0 Then Application.DeleteCustomList ListNum:=Lx ¡@'²M³æ­Y¬O¥»¦¸«Ø¥ß,§R°£²M³æ
End Sub

TOP

        ÀR«ä¦Û¦b : ¯à¥I¥X·R¤ß´N¬OºÖ¡A¯à®ø°£·Ð´o´N¬O¼z¡C
ªð¦^¦Cªí ¤W¤@¥DÃD