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

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

¦^´_ 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

¦^´_ 21# n7822123
¸U¤À·PÁ±z¸Ô²Óªº¤å¦rµù¸Ñ¡AÅý§Ú¯à«Ü§Öªº®ø¤Æµ{¦¡½Xªº·N²[¡A¨Ã¯à¦A±N¨äÂন¾A¥Î©ó¤µ±m539ªºµ{¦¡ÀÉ~·P®¦

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

TOP

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

¦^´_ 21# n7822123
´ú¸ÕÀÉ : 0730_TEST.rar (611.62 KB)
¤£¦n·N«ä¡A§Ú¹J¨ì1­Ó°ÝÃD~·Q¦Û¦æ¹Á¸Õ¸Ñ¨M¡A§Ë¤F¦Ñ¥b¤Ñ¡A«o¤@ª½µLªk¸Ñ¨M~·Ð½Ð±zÀ°¦£ÄÀºÃ¡CÁÂÁ±z!
ª¬ªp1 :
¦b±zªº´ú¸ÕÀÉ©ñ¶i2­ÓxlsÀÉ :
¿òº|¤j¼Æ¾Ú-¤j¼Ö³z-¤K¨ö±Æ§Ç-ªÅ¼ÆÁ`Äý-¦á-²Ä¤G²Ä¤T²Ä¥|²Ä¤­³Ì¥½-(2020-07-21)&¿òº|¤j¼Æ¾Ú-¤j¼Ö³z-¤K¨ö±Æ§Ç-ªÅ¼ÆÁ`Äý-©[-²Ä¤@²Ä¤G²Ä¤T²Ä¤­³Ì¥½-(2020-07-21)

¥Hµ{¦¡ÀÉ°õ¦æ­ì¨Óªº4­ÓxlsÀÉ©M¤W­zªº2­ÓÀÉ~®ÄªGÀɪºEÄæ¥u¦³­ì¨Óªº4­ÓxlsÀɪº¹ïÀ³µª®×¡A¤K¨ö¤u§@ªíªºEÄ欰ªÅ¥Õ¡C

ª¬ªp2 :
±N¤W­zªºµ{¦¡ÀÉ©M6­ÓxlsÀɤ@¨ì·sªºªÅ¸ê®Æ§¨¡A¦b°õ¦æµ{¦¡®q¡A®ÄªGÀɪºEÄæ¥þ¬°ªÅ¥Õ¡C

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

¦pªG¬OxlsÀÉAZÄ檺¤é´Á®æ¦¡¦³°ÝÃD¡A­n¦p¦ó¼W¼g"±NAZÄæ¤é´Á®æ¦¡§ó§ï¬°¯à°õ¦æªº®æ¦¡"¤§µ{¦¡½X?
ÁÂÁ±z^^

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

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

¦^´_ 24# n7822123
«¢~«¢~»~¸Ñ±zªº·N«ä¤F
­ì¨Ó¥DÀɤ£¯à©ñ¶i¦P1­Ó¸ê®Æ§¨¤º¡C

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

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

¦^´_ 26# n7822123
¸U¤À·PÁ±zªº­@¤ßÀ°¦£~·P®¦

TOP

        ÀR«ä¦Û¦b : ¤@­Ó¤H¤£©È¿ù¡A´N©È¤£§ï¹L¡A§ï¹L¨Ã¤£Ãø¡C
ªð¦^¦Cªí ¤W¤@¥DÃD