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

[µo°Ý] VBA ²¾°ÊÀx¦s®æ¦ì¸m¡A¥t¦s·sÀɤΧR°£

[µo°Ý] VBA ²¾°ÊÀx¦s®æ¦ì¸m¡A¥t¦s·sÀɤΧR°£

¤j®a¦n¡A§Ú²Ä¤@¦¸µo©«¡A¦pªG¦³¤°»ò¤£¹ïªº½Ð¨£½Ì
¦]¬°¨C¤ë³£­n¤W¥æ¤ëµ²³øªí¡A¤£·Q¦A°Å°Å¶K¶K¡A©Ò¥H¦b¹Á¸Õ¥Î¨â­Ó«ö¶s¸Ñ¨M¥¦­Ì ^^"
°ÝÃD
1) §Ú¥u¯à°µ¨ì°Å¶K²Ä¤@­Ó¤u§@­¶¡A¶K¤W«á«ç¼Ë¸Õ³£¤£¯à¥OÀx¦s®æ¦Û°Ê¸õ¨ì¤U¤@¦CªºªÅ®æ¤W¡A¥O¨ì¶K¤W²Ä¤G­Ó¤u§@ªíªº¸ê®Æ®É³£§â²Ä¤@­Ó¤u§@­¶¶K¤Wªº³£Âл\¤F /.\
2) §Ú¸ÕµÛ§â¶K¦nªº"¤ëµ²'ªº¤À­¶¥t¦s§@¤@­Ó·sªº¤u§@ªí¡A¨Ã¥B§â¤@¨Ö¦sÀɪº¥¨¶°«ü¥O¤Î¹Ï®×«ö¶s§R°£¡A¦ý§Ú¥u¯à°µ¨ì¶}¤F¤@­Ó·sÀɮסA¤£·|¦Û°Ê¦sÀɤΧR°£¥¨¶°«ü¥O¤Î¹Ï®×«ö¶s

¤Q¤À·PÁÂÀ°¦£

test save&clear.zip (18.78 KB)

¤j®a¦n¡A§Ú²Ä¤@¦¸µo©«¡A¦pªG¦³¤°»ò¤£¹ïªº½Ð¨£½Ì
¦]¬°¨C¤ë³£­n¤W¥æ¤ëµ²³øªí¡A¤£·Q¦A°Å°Å¶K¶K¡A©Ò¥H¦b¹Á¸Õ¥Î ...
lovenice831 µoªí©ó 2020-12-11 15:23


§Ú§â Module2 §R±¼,
¨Ã§â©Ò¦³ªºµ{¦¡³£¶°¤¤¦bModule1¤F :
  1.   Public iI% ' ¾ã­ÓÀɮפº³£¥i¦@¥ÎªºÅܼƩΪ«¥ó¨Ï¥ÎPublic«Å§i©ó¦¹,
  2.   Public lRows&
  3.   Public wsTar As Worksheet, wsSou(1 To 2) As Worksheet ' ­«½Æ©Ê§@·~§Q¥Îª«¥ó°}¦C»P°j°é§¹¦¨

  4. Sub Auto_Open() ' ¶}±Ò¬¡­¶Ã¯®É·|¦Û°Ê°õ¦æ, ¥i©ñ¸m·|¦@¥Î»Ý¥ýªì©l¤Æªº«ü¥O
  5.   Set wsTar = Worksheets("¤ëµ²") ' ³]©w¤u§@ªíª«¥óÅܼÆ
  6.   Set wsSou(1) = Worksheets("¤u§@ªí1")
  7.   Set wsSou(2) = Worksheets("¤u§@ªí2")
  8. End Sub

  9. Sub ¤ëµ²_Click()
  10.   With wsTar
  11.     lRows = .Cells(Rows.Count, 1).End(xlUp).Row ' ±q¤U©¹¤W§ä¨ì³Ì©³¤U¤@¦Cªº¦C¸¹
  12.     If lRows < 3 Then lRows = 3 ' ³Ì¤p¬°3, ÁקK§R±¼¼ÐÃD
  13.     .Range(.[A3], .Cells(lRows, 3)).Clear ' ²M°£¤W¦¸²£¥Íªº¸ê®Æ, ¥H«K²£¥Í·s¸ê®Æ
  14.   End With
  15.   
  16.   For iI = 1 To 2 ' ¹ï¨â­Ó¤u§@ªí³v­Ó¨ú¥X»Ý­nªº¸ê®Æ°µ³B²z
  17.     With wsSou(iI)
  18.       .Select ' ©³¤U§@¥ÎÀx¦s®æ²¾¨ìAÄæ³Ì·s¸ê®Æ¦C«e,»Ý¥ý±N¤u§@ªíSelect
  19.       .[A3].AutoFilter Field:=2, Criteria1:="¥xÆW"
  20.       .Range(.[A3], .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 3)).Copy wsTar.Cells(Rows.Count, 1).End(xlUp).Offset(1)
  21.          ' «þ¨©»Ý­nªº¸ê®Æ, ¶K¨ì¤ëµ²¤u§@ªíªº¸ê®Æ³Ì·s¦C
  22.       .[A3].AutoFilter Field:=2
  23.       .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1).Offset(1).Select ' §@¥ÎÀx¦s®æ²¾¨ìAÄæ³Ì·s¸ê®Æ¦C-AÄæ±q¤U©¹¤Wºâ³Ì©³¤U¤@¦Cªº¤U¤è¨º®æ
  24.     End With
  25.   Next
  26.   wsTar.Select ' Åã¥Ü¤ëµ²¤u§@ªí
  27. End Sub

  28. Sub test_()
  29.   Dim Vsha
  30.   Dim wsNew As Worksheet, wsTemp As Worksheet
  31.    
  32.     With Workbooks.Add
  33.       Set wsTemp = .ActiveSheet
  34.       wsTar.Copy before:=.Worksheets(1)
  35.       Set wsNew = .ActiveSheet
  36.       wsTemp.Delete
  37.       Set wsTemp = Nothing
  38.       With wsNew
  39.         .name = .[11]
  40.         For Each Vsha In .Shapes
  41.           Vsha.Delete
  42.         Next
  43.         .Parent.SaveAs ThisWorkbook.Path & Application.PathSeparator & .name
  44.       End With

  45.       .Close False
  46.     End With
  47. End Sub
½Æ»s¥N½X
test save&clear-a.zip (22.04 KB)

TOP

¦^´_ 2# luhpro


   ¤Q¤À·PÁÂÀ°¦£:handshake :handshake

TOP

°Ñ¦ÒÀÉ:
Xl0000397-1.rar (13.92 KB)

TOP

¦^´_ 4# ­ã´£³¡ªL
¥ýÁÂÁÂÀ°¦£¡A¦ý¦³°ÝÃD·Q½Ð±Ð¤@¡A´N¬O¦pªG¥Î³o­Ó¿z¿ï¥X¨Óªº¸ê®Æ¡A¯àµ¹¥X©T©wÄæ¶Ü?
§Ú¸Õ¤F¦n´X¤Ñ¤]¥u¯à°µ¨ì§â¿z¿ï¥X¨Óªº¸ê®Æ¦b¶K¤Wªº®É­Ô¦V¤U²¾¼Æ¦æ©Î¥k²¾¼ÆÄæ¤~¶K¤W¡A´N¬O¤£¯à¦¬¯¶½Æ»sªºÄæ¼Æ
¥u»Ý­n30Äæ¡A¦ý«ç¼Ë¤]§ï¤£¨ì¡A§Æ±æ¯à°÷À°¦£¡AÁÂÁÂ


,
         If .FilterMode Then .ShowAllData
         .[b7].AutoFilter Field:=2, Criteria1:=xS.[j2]
         .AutoFilter.Range.Offset(1, 2).Copy xS.Cells(Rows.Count, 1).End(xlUp)(2)
         .ShowAllData

TOP

¦^´_ 5# lovenice831


30Äæ¬O³sÄòªº¶Ü??? ÁÙ¬O¸õÅDªº???
²Ä´XÄæ¨ì´XÄæ???

TOP

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


    ¤£¦n·N«ä¡A§Ú»¡±o¤£¤Ó²M·¡¡A¬O³sÄòªº¡A¥ÑC Äæ¨ì AF Äæ¡A¨ä¹ê¬O§_¥u­n§Ú¿z¿ï³o¦C¤]¯à逹¨ì³o­Ó®ÄªG©O? ÁÂÁ¸ѵª

TOP

¦^´_ 7# lovenice831

Sub ¤ëµ²()
Dim xS As Worksheet, T$, i&, xE As Range
Call ²M°£
Set xS = Sheets("¤ëµ²")
If xS.[C1] = "" Then MsgBox "½Ð¿é¤J¿z¿ï¤å¦r!  ": Exit Sub
For i = 1 To 2
    With Sheets(i)
         If .FilterMode Then .ShowAllData '­Y¤u§@ªí¿z¿ï¤¤, Åã¥Ü[¥þ³¡]
         .[A2].AutoFilter Field:=2, Criteria1:=xS.[C1] '°õ¦æ¿z¿ï
          Set xE = xS.Cells(Rows.Count, 1).End(xlUp)(2)
         .AutoFilter.Range.Offset(1, 2).Resize(, 30).Copy xE '½Æ»s¿z¿ï¸ê®Æ  '2 = cÄæ (±qAÄæºâ°_0-1-2)
         .ShowAllData '«ì´_Åã¥Ü[¥þ³¡]
    End With
Next i
End Sub

TOP

¦^´_ 8# ­ã´£³¡ªL
ÁÂÁÂÀ°¦£¡A¦ý§Ú¤£ª¾¥X²{¤°»ò°ÝÃD¡A¸ÕµÛ¸ÕµÛ¡A²{¦b¥þ³£¥Î¤£¨ì¡A³Â·ÐÀ°¦£¬d¬Ý¤@¤U¡AÁÂÁÂ


    test Inventory.rar (486.34 KB)

TOP

¦^´_ 9# lovenice831


§ÚªºÂª©excel¥´¤£¶}ªþ¥ó,
¬Ý§O¤H¯à§_À°¦£~~

TOP

        ÀR«ä¦Û¦b : ¤H¥Í¤£¤@©w²y²y¬O¦n²y¡A¦ý¬O¦³¾ú½mªº±j¥´ªÌ¡AÀH®É³£¥i¥H´§´Î¡C
ªð¦^¦Cªí ¤W¤@¥DÃD