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

[µo°Ý] ¨Ì¾ÚInputBox¶ñ¤Jªº¤é´ÁÅã¥Ü¸ê®Æ

¥»©«³Ì«á¥Ñ n7822123 ©ó 2020-7-26 22:58 ½s¿è

¦^´_ 1# papaya


DATAªºAÄæ ¬O"¦r¦ê®æ¦¡" (2020/7/7  (¤G))¡AInputBox¿é¤Jªº¤é´Á¤]¬O"¦r¦ê®æ¦¡" (2020707)

¨â­Ó®æ¦¡³£¬O"¦r¦ê" ¤Sªøªº¤£¤Ó¤@¼Ë¡A­n«ç»ò¤ñ?

¥Î©î¸Ñ¦r¦ê¤è¦¡?  ·|«Ü³Â·Ðªü!

«Øij¤é´Á´N¦^Âk¨ì¤é´Á®æ¦¡¡A¥i¥H¥Î¦Û­q®æ¦¡ "yyyy/mm/dd (aaa)"

¤é´Á®æ¦¡¥i¥H°µ¹Bºâ¡A¦r¦ê®æ¦¡¤£¯à
µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

¥»©«³Ì«á¥Ñ n7822123 ©ó 2020-7-27 00:58 ½s¿è

¦^´_ 3# papaya


¥ýÀ°§A§âAÄ檺®æ¦¡§ï¦¨¤é´Á®æ¦¡¡A§Ú¦Û»{µù¸Ñ¼g¤£¤Ö....¥B¨¾§b¼g¤£¤Ö

©Ò¥Hµ{¦¡¼gªº¤ñ¸ûªø¤@ÂI¡A§Æ±æ¬ÝªºÀ´§a~ µ{¦¡¦p¤U


Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim Arr, ¦¹ªí As Worksheet, ¤é´Á As Date, tim!, rg As Range, Rn&, xlsNm$, sh
Arr = Array("¤C¬F", "¤K¨ö", "¤­¦æ", "¤»¨R", "¥Í¨v", "¦X¼Æ", "§¡­È", "§À¼Æ")
Set ¦¹ªí = ActiveSheet
'1_¥ý³]¥ß1­Ó¥i¿é¤J¤é´Á(yyyymmdd)ªºInputBox
¤é´Á = InputBox("½Ð¿é¤J¤é´Á¡A®æ¦¡Ex:2020/07/07", "¿é¤J¤é´Á")
If IsEmpty(¤é´Á) Then Exit Sub
'ÀɮצWºÙ="¤j¼Ö³z_¿òº|ªÅÁ`²Î­pªí_¿é¤JInputBoxªº¤é´Á¡¨
xlsNm = "¤j¼Ö³z_¿òº|ªÅÁ`²Î­pªí_" & Format(¤é´Á, "mmdd")
'Àˬd¬O§_¤w¦³ÀÉ®×(ÁקK­«Âаõ¦æ)
Àˬd$ = Dir(ThisWorkbook.Path & "\" & xlsNm & ".xls*")
If Àˬd <> "" Then
  re% = MsgBox("¦¹Àɮפw¦s¦b¡A½Ð½T»{¬O§_Âл\?", vbYesNo)
  If re = vbNo Then Exit Sub Else Kill ThisWorkbook.Path & "\" & Àˬd
End If
tim = Timer  '¶}©l­p®É
'¤ñ¹ï¤é´Á
For Each rg In Range([A1], [A1].End(4))
  If rg = ¤é´Á Then Rn = rg.Row: Exit For
Next
'¦pªG¸ÓB¡JH="¡¨®É¡A«hArrªºA1¤]="¡¨
If Rn = 0 Then MsgBox "§ä¤£¨ì¤é´Á": Exit Sub
For Each sh In Arr
  With Sheets(sh): ¦¹ªí.Activate
    '2_¸Ó¤é´Á¶ñ¤J"¤C¬F","¤K¨ö","¤­¦æ","¤»¨R","¦X¼Æ","¥Í¨v","§¡­È","§À¼Æ"ªº¦U¤u§@ªí
    .[A1] = Format(¤é´Á, "yyyy/mm/dd")
    '¨Ã±NDATAªºAÄæ=X¤é´Áªº¤U1¦C¤§B¡JH¼Æ­È¶ñ¤J
    .[A3].Resize(7) = Application.Transpose(Cells(Rn + 1, 2).Resize(, 7))
  End With
Next
'3_±N§¹¦¨²Ä2¶µªº"Arr"¿é¥X¬°1­Ó¿W¥ßÀÉ®×
With Workbooks.Add
  For i = 0 To UBound(Arr)
    ThisWorkbook.Sheets(Arr(i)).Copy After:=.Sheets(.Sheets.Count)
  Next
  .Sheets(Array(1, 2, 3)).Delete
  .SaveAs ThisWorkbook.Path & "\" & xlsNm    '¨Sµ¹°ÆÀɦW¡AªO·sª©Excel³£¾A¥Î
  .Close True
End With
[Q2] = Round(Timer - tim, 2)
End Sub


Àɮצp¤U

49¤j¼Ö³z(¥DÀÉ).rar (22.26 KB)

§A¥t¤@©«»Ý¨D·Pı§ó¦h¡A¥ú¬Ý°_¨Ó´N·Pı¦³ÂI³Â·Ð.....

¬Ý¦³¨S¦³¤HÄ@·NÀ°§A¡A¤µ¤Ñ¥ý³o¼Ë
µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

¦^´_ 6# papaya


Array(1, 2, 3)¬O«ü¤°»ò½d³òªº¤u§@ªí³Q§R°£¤F?

·s¼W¬¡­¶Ã¯·|¹w³]¦³3­Ó¤u§@ªí¡A©Ò¥H§â«e3­Ó¤u§@ªí§R°£

§A§â¨º¤@¦æµù¸Ñ±¼¡A¦A°õ¦æ´Nª¾¹D¬O¤°»ò¤F  

¦pªG¤£¤@¦¸¼g¡A­n¤À¤T¦æ¼g¡A·|Åܦ¨¦p¤U(³sÄò§R°£²Ä¤@­¶¤u§@ªí¡A3¦¸)


sheets(1).delete
sheets(1).delete
sheets(1).delete
µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

¥»©«³Ì«á¥Ñ n7822123 ©ó 2020-7-29 03:01 ½s¿è

¦^´_ 9# papaya

¤Ì.........§A³o¼Ë±Ô­z¡A§Ú¯uªº¬Ý¤£À´...............

¥ýÀɮ׶}©l»¡§a¡A¬°¤°»ò§Aªº½d¨Ò1 "2020/5/15" ­n§ä¤W

"±N¿òº|¤j¼Æ¾Ú-¤j¼Ö³z-¤C¬F±Æ§Ç-ªÅ¼ÆÁ`Äý-¤g-²Ä¤G²Ä¤T²Ä¥|²Ä¤­³Ì¥½-(2020-07-21)" ³o­ÓÀÉ®×?

¬°¤°»ò§Aªº½d¨Ò2 "2020/7/21" ­n´«¦¨

"±N¿òº|¤j¼Æ¾Ú-¤j¼Ö³z-¥Í¨v±Æ§Ç-ªÅ¼ÆÁ`Äý-ª¯-²Ä¤G²Ä¤T³Ì¥½-(2020-07-21)ªºAZ2 (2020/7/21)" ³o­ÓÀÉ®×?


§¹¥þ¬Ý¤£À´¦³¤°»òÃöÁp

ÁÙ¦³±Ô­zªº¥y¤l¡A¯à¨Ï¥Î

"XXX"ÀÉ®× ªº"OOO" Äæ¦ì ½Æ»s¨ì "PPP"ÀÉ®× ªº "KKK"Äæ¦ì

³oºØ¤è¦¡¶Ü?

§Aªº±Ô­z¬Ýªº¯uªº«Ü¶Ã¡A§¹¥þ¤£ª¾¹D¬O«ü "ÀÉ®×" ÁÙ¬O "¤u§@ªí" ÁÙ¬O "Äæ¦ì" !


µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

¥»©«³Ì«á¥Ñ n7822123 ©ó 2020-7-30 01:43 ½s¿è

¦^´_ 18# papaya


¦n¡A«Ü²M·¡¡A§Ú¬ÝÀ´¤F

¤£¹L§Ú¥i¯à·|¤Ï¹L¨Ó¼g¡A¦]¬°³o¼Ë¤ñ¸û²³æ

¨Ì¸ê®Æ§¨¤ºªºÀÉ®×"ÀɦW"·j´M¤@¹M¡A

¦pªG¦³¹ïÀ³ªºÄæ¦ì¦A¥´¶}ÀɮסA·j´M¤é´Á¡A

¨Ã§â¬ÛÀ³­È¶ñ¤W¡A³o­Ó¼gªk¥u»Ý¶]¤@¦¸°j°é(ÀÉ®×°j°é)

§Aªº¨BÆJ¼g°_¨Ó·|¤ñ¸û³Â·Ð¡A­n¤T­Ó°j°é

¤u§@ªí1­Ó°j°é(¤C¬F¡B¤K¨ö...)  BÄæ1­Ó°j°é(¤g¡B¤é...)  CÄæ1­Ó°j°é(²Ä¤@²Ä¤G...)

¦Ó¥B¹³³oºØ¤Öªº½d¨ÒÀÉ(4­Ó)¡A«Ü¦hÄæ¦ì³£§ä¤£¨ì¬Û¹ïÀ³ÀɮסA

©Ò¥H¤Ï¹L¨Ó¥ÎÀɮקäÄæ¦ì¡A·|¤ñ¸û¦³®Ä²v

§Ú¥ý¾ã²z¤@¤U«ä¸ô¡A³Ì§Ö¤]­n©ú¤Ñ¤~¯à¼gµ¹§A¡C
µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

¦^´_ 20# papaya

§âExcelÀÉ©ñ¨ì ¦P¸ô®|¤Uªº"xlsÀÉ" ¸ê®Æ§¨«á¡A¦A°õ¦æ´N¥i¥H¤F

¥i¦Û¦æ§ï¸ô®|¦ì¸m(­×§ïµ{¦¡¸Ì­±ªº "xlsPath")

¦Ü©ó¤@¶}©lªºcsvÀÉ¡A§A¥i¥H¥t¼gµ{¦¡ÂনxlsÀÉ

´ú¸ÕÀÉ¥u¦³4­Ó¡A©Ò¥H¤£·|ªá¤Óªø®É¶¡ (Àɮ׶V¤Ö¡A®É¶¡¶Vµu)

¦Ü©ó§A­ì¥»ªº¤W¦Ê­ÓÀɮסA¥i¯à·|ªá¤W¼Æ¤ÀÄÁ

µ{¦¡¦p¤U


Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim Arr, ¦¹ªí As Worksheet, ¤é´Á As Date, tim!, rg As Range, Rn&, xlsNm$, sh
Dim Key$, Item$, xlsPath$, xlsÀÉ$, K1$, K2$, K3$, Ri&
Set D = CreateObject("Scripting.Dictionary")
Arr = Array("¤C¬F", "¤K¨ö", "¤­¦æ", "¤»¨R", "¥Í¨v", "¦X¼Æ", "§¡­È", "§À¼Æ")
Set ¦¹ªí = ActiveSheet
'---------------------------------------------
'1_¥ý³]¥ß1­Ó¥i¿é¤J¤é´Á(yyyymmdd)ªºInputBox
¤é´Á = InputBox("½Ð¿é¤J¤é´Á¡A®æ¦¡Ex:2020/07/07", "¿é¤J¤é´Á")
If IsEmpty(¤é´Á) Then Exit Sub
'ÀɮצWºÙ="¤j¼Ö³z_¿òº|ªÅÁ`²Î­pªí_¿é¤JInputBoxªº¤é´Á¡¨
xlsNm = "¤j¼Ö³z_¿òº|ªÅÁ`²Î­pªí_" & Format(¤é´Á, "mmdd")
'Àˬd¬O§_¤w¦³ÀÉ®×(ÁקK­«Âаõ¦æ)
Àˬd$ = Dir(ThisWorkbook.Path & "\" & xlsNm & ".xls*")
If Àˬd <> "" Then
  re% = MsgBox("¦¹Àɮפw¦s¦b¡A½Ð½T»{¬O§_Âл\?", vbYesNo)
  If re = vbNo Then Exit Sub Else Kill ThisWorkbook.Path & "\" & Àˬd
End If
tim = Timer  '¶}©l­p®É
'¤ñ¹ï¤é´Á
Set rg = Range([A1], [A1].End(4)).Find(¤é´Á, , , xlWhole)
If Not rg Is Nothing Then Rn = rg.Row
'¦pªG¸ÓB¡JH="¡¨®É¡A«hArrªºA1¤]="¡¨
If Rn = 0 Then MsgBox "§ä¤£¨ì¤é´Á": Exit Sub
For Each sh In Arr
  With Sheets(sh): ¦¹ªí.Activate
    '2_¸Ó¤é´Á¶ñ¤J"¤C¬F","¤K¨ö","¤­¦æ","¤»¨R","¦X¼Æ","¥Í¨v","§¡­È","§À¼Æ"ªº¦U¤u§@ªí
    .[A1] = Format(¤é´Á, "yyyy/mm/dd")
    '¨Ã±NDATAªºAÄæ=X¤é´Áªº¤U1¦C¤§B¡JH¼Æ­È¶ñ¤J
    .[A3].Resize(7) = Application.Transpose(Cells(Rn + 1, 2).Resize(, 7))
  End With
Next
'---------------------------------------------
'±NÄæ¦ì¸ê®Æ¸Ë¶i¦r¨å(¨Ñ«á­±¬d¸ß)+²MªÅµ{¦¡Àɤu§@ªí¸ê®Æ
For Each sh In Arr: With Sheets(sh)
  Rn = [B5000].End(3).Row
  For R = 2 To Rn
    If .Cells(R, 2) <> "" Then
      '§â3ºØÃöÁä¦r²Õ¦X°_¨Ó·í¦r¨åªºKey (CÄæ¦r¦ê¤¤¦³ªÅ¥Õ³´¨À)
      Key = .Name & "-" & .Cells(R, 2) & "-" & Replace(.Cells(R, 3), " ", "")
      D(Key) = R   'Item©ñ'¦C¸¹'
      .[E2].Resize(Rn - 1, 14).ClearContents  '²MªÅ¸ê®Æ
    End If
  Next R
End With: Next sh
'-----------------------------------------------
xlsPath = ThisWorkbook.Path & "\xlsÀÉ\"   '²Î¤@§âxls©ñ¦bxlsÀɸê®Æ§¨ -¥i¦Û¦æ­×§ï¸ê®Æ§¨¦WºÙ~
xlsÀÉ = Dir(xlsPath & "*.xls*")
Do While xlsÀÉ <> ""
  K1 = Replace(Split(xlsÀÉ, "-")(2), "±Æ§Ç", "")
  K2 = Split(xlsÀÉ, "-")(4)
  K3 = Split(xlsÀÉ, "-")(5)
  Key = K1 & "-" & K2 & "-" & K3
  If D.Exists(Key) Then  '¬d¦r¨å´M§ä¬O§_¦³Äæ¦ì
    With Workbooks.Open(xlsPath & xlsÀÉ).Sheets(1)
      'Step_3¡G¥HStep_1ªºA1¤é´Á(©Î=InputBox¿é¤Jªº¤é´Á)·j´MAZÄ椤ªº¬Û¦P¤é´Á
      Set rg = .Range(.[AZ1], .[AZ1].End(4)).Find(¤é´Á, , , xlWhole)
      'Step_4¡G±NStep_3 ·j´M¨ìªº¤é´Á¤§¤W1¦CªºBA¡JBS¤º®e¡A½Æ»s¶K¤WStep_1¬Û¹ïÀ³ªºEÄæÀx¦s®æ(=E7)
      If Not rg Is Nothing Then Ri = rg.Row - 1 Else .Parent.Close False: GoTo ¤U¤@ÀÉ
      ¦¹ªí.Parent.Sheets(K1).Cells(D(Key), "E").Resize(, 14) = .Cells(Ri, "BA").Resize(, 14).Value
      .Parent.Close False  'Ãö³¬xlsÀÉ
    End With
  End If
¤U¤@ÀÉ:  xlsÀÉ = Dir
Loop
'-------------------------------------------------------
'3_±N§¹¦¨ªº¤u§@ªí¿é¥X¬°1­Ó¿W¥ßÀÉ®×
With Workbooks.Add
  For Each sh In Arr
    ¦¹ªí.Parent.Sheets(sh).Copy After:=.Sheets(.Sheets.Count) '½Æ»sArr¦U¤u§@ªí¤º®e
  Next
  .Sheets(Array(1, 2, 3)).Delete
  .SaveAs ThisWorkbook.Path & "\" & xlsNm    '¨Sµ¹°ÆÀɦW¡AªO·sª©Excel³£¾A¥Î
  .Close True
End With
[Q2] = Round(Timer - tim, 2) & "’"
End Sub


Àɮצp¤U¡A¦³°ÝÃD¦A»¡¹Æ

¤j¼Ö³z.rar (679.52 KB)
µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

¥»©«³Ì«á¥Ñ n7822123 ©ó 2020-7-30 23:22 ½s¿è

¦^´_ 22# papaya


¥t¥~~·Q¦bR2¶ñ¤J=InputBox¿é¤J¤é´Á(EX : 2020/7/21)¡F¦bS2¶ñ¤J·í¦¸§¹¦¨°õ¦æªºÀÉ®×­Ó¼Æ(EX : 4­Ó)
½Ð°Ý : µ{¦¡½X­n«ç»ò¼W¼g?  

§A«üªº¬O¦³®Äªº°õ¦æÀɮ׭ӼƧa!?  

¦pªG¤ñ¹ïÀɮצWºÙ¦³Äæ¦ì¡A¨Ã¤w¸g¥´¶}ÀÉ®×

¦ý¬O¦bAZÄæ¦ì§ä¤£¨ì§A¿é¤Jªº¤é´Á

³oºØ±¡ªpÀ³¸Ó¤£ºâ"¦³®Ä°õ¦æ"§a


ºÃ´b~
¬°¤°»òª¬ªp1ªº6­ÓxlsÀɪºAZÄæ¤é´Á®æ¦¡§¹¥þ¬Û¦P¡A¬°¤°»ò­ì¨Óªº4­ÓÀɮׯ঳¦³®Ä°õ¦æ¡A·s¥[¤Jªº2­ÓÀɮ׫o¤£¦æ?

¤Ì....§Ú6­Ó³£¦¨¥\°õ¦æ¤F¡A­n§âxls©ñ¤J"xlsÀÉ"¸ê®Æ§¨¤º¤~·|³Q±½´y¨ì³á~

§ó·s­pºâ°õ¦æÀɮ׭ӼơA¨ÃÅã¥Ü¦bS2Äæ¦ì¡A

§A¦A´ú¬Ý¬Ý¡A¦p¤Uªþ¥ó


¤j¼Ö³z_0730_TEST.rar (696.08 KB)
µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

¦^´_ 25# papaya



¥t¥~~·Q¦bR2¶ñ¤J=InputBox¿é¤Jªº¤é´Á(EX : 2020/7/17©Î2020/7/21)
µ{¦¡½XÀ³¸Ó¦p¦ó½s¼g?

²K¥[¤@¦æ´N¥i¥H¤F¡A¦p¤U~

'---------------------------------------------
'1_¥ý³]¥ß1­Ó¥i¿é¤J¤é´Á(yyyymmdd)ªºInputBox
¤é´Á = InputBox("½Ð¿é¤J¤é´Á¡A®æ¦¡Ex:2020/07/07", "¿é¤J¤é´Á")
[R2] = ¤é´Á   
µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

        ÀR«ä¦Û¦b : §Ú­Ì³Ì¤jªº¼Ä¤H¤£¬O§O¤H¡D¥i¯à¬O¦Û¤v¡C
ªð¦^¦Cªí ¤W¤@¥DÃD