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

[µo°Ý] ¿E¬¡¤u§@ªíªº°ÝÃD

[µo°Ý] ¿E¬¡¤u§@ªíªº°ÝÃD

½d¥»¤¤¦pµL¦¹¤u§@ªí´N·s¼W,¦p¤w¦s¦bªº¤u§@ªí´N±NÂ^¨ú¼Æ¾Ú¶Ç¦Ü[¦s¦b¤u§@ªí],¬°¦ó¤£¦æ.
ms1="¾P¶×3¤ë"
WORKSHEETS(MS1)............³o­Ó¤£¦æ.

WORKSHEETS.rar (34.14 KB)

§ù¤p¥­

¦^´_ 1# dou10801


    ÁÂÁ½׾Â,ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾ÇÂǦ¹©«½m²ß°}¦C,¾Ç²ß¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò


Option Explicit
Sub TEST()
Application.DisplayAlerts = False
Dim Brr, R&, i&, j&, Nsht$, Sht, M
Sht = Application.InputBox("½Ð¿é¤J¾P¶×©Î¶i¶×", "¤u§@ªí¦WºÙ", "¾P¶×", , , , , 2)
If InStr("¾P¶×/¶i¶×", Sht) = 0 Then Exit Sub Else Nsht = Sht: Set Sht = Sheets(Sht)
M = Application.InputBox("½Ð¿é¤J¤ë¥÷", "¤u§@ªí¦WºÙ", 3, , , , , 2)
If Val(M) = 0 Then Exit Sub Else Nsht = Nsht & M & "¤ë"
Brr = Range(Sht.[P1], Sht.[A65536].End(3))
For i = 1 To UBound(Brr)
   If Format(Brr(i, 2), "M") <> Val(M) And i <> 1 Then GoTo i01
   R = R + 1: For j = 1 To 16: Brr(R, j) = Brr(i, j): Next
i01: Next
On Error Resume Next
Sheets(Nsht).Delete
With Worksheets.Add(after:=Worksheets(Sheets.Count))
   .Name = Nsht
   .[A1].Resize(R, 16) = Brr
   .Columns(2).NumberFormatLocal = "yyyy-m-d"
   .EntireColumn.AutoFit
End With
Erase Brr: Set Sht = Nothing
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2024-1-17 20:06 ½s¿è

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½Æ²ß¬Q¤Ñªº¤è®×,¤è®×¾Ç²ß¤ß±oµù¸Ñ¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

Option Explicit
Sub TEST()
Application.DisplayAlerts = False
'¡ô¥O¤£­n¦A¸õ¥X¸ß°Ýµ¡(°Ý¯uªº­n§R°£¤u§@ªí¶Ü?),ª½±µ§R¤F!
Dim Brr, R&, i&, j&, Nsht$, Sht, M
'¡ô«Å§iÅܼÆ
Sht = Application.InputBox("½Ð¿é¤J¾P¶×©Î¶i¶×", "¤u§@ªí¦WºÙ", "¾P¶×", , , , , 2)
'¡ô¥OShtÅܼƬO ¿é¤Jµ¡ªº¦^¶Çµ²ªG
If InStr("¾P¶×/¶i¶×", Sht) = 0 Then Exit Sub Else Nsht = Sht: Set Sht = Sheets(Sht)
'¡ô¦pªGInStr()¦^¶Ç ShtÅܼƤ£¥]§t¦b¦r¦ê¸Ì!´Nµ²§ôµ{¦¡,§_«h
'§_«h´N¥ONshtÅܼÆ(¦r¦ê)¬O shtÅܼƭÈ,¥OShtÅܼƬO¦W¬° ShtÅܼƪº¤u§@ªí
M = Application.InputBox("½Ð¿é¤J¤ë¥÷", "¤u§@ªí¦WºÙ", 3, , , , , 2)
'¡ô¥OMÅܼƬO ¿é¤Jµ¡ªº¦^¶Çµ²ªG
If Val(M) = 0 Then Exit Sub Else Nsht = Nsht & M & "¤ë"
'¡ô¦pªGInStr()¦^¶Ç­ÈÂà¤Æ¬°¼Æ­È«á¬O 0!´Nµ²§ôµ{¦¡,§_«h
'§_«h¥ONshtÅܼƫ᭱¦A³s±µ MÅܼÆ,¦A³s±µ "¤ë",¦¨¬°·s¦r¦ê

Brr = Range(Sht.[P1], Sht.[A65536].End(3))
'¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,¥HShtÅܼÆ(¤u§@ªí)ªºA~PÄæÀx¦s®æ­È±a¤J°}¦C¤¤
For i = 1 To UBound(Brr)
'¡ô³]¶¶°j°é!
   If Format(Brr(i, 2), "M") <> Val(M) And i <> 1 Then GoTo i01
   '¡ô¦pªG²Ä2Äæ°}¦C­È(¤é´Á)¤ë¥÷ ¤£¦P©óMÅܼÆÂà¤Æ¬°ªº¼Æ­È,
   '¦Ó¥BiÅܼƤ£¬O1,´N¸õ¨ì¼Ð¥Üi01ªº¦ì¸mÄ~Äò°õ¦æ

   R = R + 1: For j = 1 To 16: Brr(R, j) = Brr(i, j): Next
   '¡ô¥ORÅܼưO¿ýµ²ªG¸ê®Æ­n©ñ¦b²Ä´X¦C,
   '³]¶¶°j°é,±Nµ²ªG¸ê®ÆÂл\±¼­ì°}¦C¸ê®Æ,¼g¤J²Å¦X±ø¥óªº¸ê®Æ

i01: Next
On Error Resume Next
'¡ô¥Oµ{§Ç¹J¨ì¿ù»~¤£°±¤U¨Ó,Ä~Äò¶i¦æ¤U­Óµ{§Ç
Sheets(Nsht).Delete
'¡ô¥O§R°£¦W¬° NshtÅܼƪº¤u§@ªí(¦pªG¨S¦³¦¹¤u§@ªí¥i§R°£,·|¸õ¹L)
With Worksheets.Add(after:=Worksheets(Sheets.Count))
'¡ô¥H¤U¬OÃö©ó¦b¯Á¤Þ³Ì«á·s¼W¤@­Ó¤u§@ªíªºµ{§Ç
   .Name = Nsht
   '¡ô¥O¤u§@ªí¦W¦r¬O NshtÅܼƩұaªº¦r¦ê
   .[A1].Resize(R, 16) = Brr
   '¡ô¥O[A1]Àx¦s®æÂX®i¾A·í½d³ò¼g¤JBrr°}¦C­È,¶W¹L¦¹½d³òªº°}¦C­È©¿²¤
   .Columns(2).NumberFormatLocal = "yyyy-m-d"
   '¡ô¥OBÄæ®æ¦¡¨Ì·Ó³]©w¤è¦¡Åã¥Ü
   .EntireColumn.AutoFit
   '¡ô¥O³o½d³òÄæ¦ì¦Û°Ê½Õ¾ãÄæ¼e
End With
Erase Brr: Set Sht = Nothing
'¡ô¥OÄÀ©ñÅܼÆ
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 3# Andy2483
·PÁ Andy2483 ¦¬¤U¾Ç²ß.
§ù¤p¥­

TOP

        ÀR«ä¦Û¦b : ¦³¦h¤Ö¤O¶q´N°µ¦h¤Ö¨Æ¡A¤£­n¤ß¦sµ¥«Ý¡Aµ¥«Ý¤~·|¸¨ªÅ¡C
ªð¦^¦Cªí ¤W¤@¥DÃD