Scott090

¦^´_ 26# Airman


   

¤U¸ü (78.7 KB)

2019-5-6 10:20

   

¤U¸ü (89.03 KB)

2019-5-6 10:21

  §ÚªÌ¸Ìªº°õ¦æµ²ªG

Airman

¦^´_ 25# Scott090

µ²ªG¦pªþ¤Wªº2019-0405_²Î­p©M2019-0406_²Î­p~µª®×¤£¹ï^^"

Scott090

¦^´_ 24# Airman


    §A¨S°õ¦æªº³¡¤À¬O¹ï¤ÀÃþªº±Æ§Ç¡C

     µ²ªG¤S¦p¦ó?

Airman

©Ó¤W¼Ó~
¨þ~¨þ~¬O¤p§Ì±N¦C115~¦C119"¤£°õ¦æ"~´ú¸Õ«á¡F
§Ñ¤F«ì´_­ì½Z^^"

Airman

¦^´_ 22# Scott090
Scott090¤j¤j:±z¦n!
­n§âµ{¦¡Àɸò¸ê®ÆÀÉ©ñ¦b¦P¤@¸ô®|~¦³
½Ð°Ý¦³¥X²{¦p¤W¹Ï¦³ÀɮצWºÙªº¤u§@ªí¶Ü?~¦³

¤£¾å±o¬O¤°»ò­ì¦]?²{¦b«o¥i¥¿±`°õ¦æ^^
¦ý¿é¥X«áªºµª®×Àɤº®e¤£¥¿½T^^"
·Ð½ÐÀ˵ø©M½ç¥¿¡C
ÁÂÁ±z!±ß¦w!

(§¡­È±Æ§Ç).rar (68.7 KB)

¤U¸ü¦¸¼Æ: 2

2019-5-6 00:24

Scott090

¦^´_ 21# Airman


  ­n§â§âµ{¦¡Àɸò¸ê®ÆÀÉ©ñ¦b¦P¤@¸ô®|¡C

   

¤U¸ü (56.58 KB)

2019-5-5 22:23

  ½Ð°Ý¦³¥X²{¦p¤W¹Ï¦³ÀɮצWºÙªº¤u§@ªí¶Ü?

Airman

¦^´_ 20# Scott090

¤U¸ü (41.88 KB)

2019-5-5 22:06

                     

¤U¸ü (69.74 KB)

2019-5-5 22:06

Scott090¤j¤j:±z¦n!
ÁÂÁ±zªº­×¥¿^^
¤£¦n·N«ä¡A°õ¦æ«á~¥X²{"½s¿è¿ù»~"ªº´£¥Ü^^"
·Ð½Ð½ç¥¿!ÁÂÁ±z^^

Scott090

¦^´_ 19# Airman


    ©êºp¡A¸Õ¹BÂà«á¨S¦³ remark ' ®³±¼¡C
     ¤£¥Î¤H¤u¤JÀɦW
     ½Ð­«¸Õ
    Option Explicit
Option Base 1

''===================
Sub Main()
      Dim wb As Workbook, sh As Worksheet, shSample As Worksheet, fpath$
      Dim arColor%(7), arDATA
      Dim i%, j%, k%, fileNo%, RowNo%, colNo%
      Dim Cat$    'Àɮרt¦C¥N½X
      Dim colorNo%      '©³¦â¼Æ
      
      colorNo = 7
      colNo = 49
      ReDim arDATA(colorNo, colNo)
      
      Application.ScreenUpdating = False
      
      fpath = ThisWorkbook.Path
      
'¨ú±o±ýµû¦ôªºÀÉ®×
'================
   getFileNames
      
'¨úÀx¦s®æ©³¦âªíCaeColor
'==================
      Set shSample = ThisWorkbook.Sheets("Sample")
      With shSample
            colorNo = 7       '7ºØ©³¦â
            For i = 1 To colorNo
                 arColor(colorNo - i + 1) = .Cells(i + 1, 1).Interior.ColorIndex
           Next
      End With
      
      Set sh = ThisWorkbook.Sheets("FileNameSh")
      
      fileNo = 1: Cat = sh.Cells(1, 2)
      Do While sh.Cells(fileNo, 2) <> ""
            If sh.Cells(fileNo, 2) <> Cat Then GoSub FinishCatFile: Cat = sh.Cells(fileNo, 2)
            
                  DoEvents
                  Application.ScreenUpdating = False
                  
                  Set wb = Workbooks.Open(fpath & "\" & sh.Cells(fileNo, 1))
                  RowNo = [B65536].End(xlUp).Row
                  If RowNo < 10 Then GoTo NextFile          '­ì³W«h³] Rowno <10 «h¤£³B²z
                  
                  RowNo = RowNo - 1 - colorNo
                  For i = 1 To colorNo                '±q 1 ~ 7 ©³¦â
                        
                        For j = 1 To colNo            '±q 1~ 49 Äæ
                              For k = 0 To i - 1            '¬d®Ö³sÄò¬Û¦P©³¦â
                                    If RowNo - k = 1 Then GoTo NextFile       'Àɮתº¦³®Ä¦C¼Æ¤ñ©³¦â¼Æ¤Ö¡ACellsªº¦C¤w¨ì²Ä1¦C
                                    If Cells(RowNo - k, j + 1).Interior.ColorIndex <> arColor(i) Then GoTo NextCol
                              Next
                              arDATA(colorNo - i + 1, j) = arDATA(colorNo - i + 1, j) + 1
NextCol:
                        Next
NextColor:
                   Next
            
NextFile:
            wb.Close (fpath & "\" & sh.Cells(fileNo, 1))
            Set wb = Nothing
            fileNo = fileNo + 1
            
      Loop
      GoSub FinishCatFile           'For the last one date code catagory
      
Exit Sub

FinishCatFile:
      With shSample
            .[b2].Resize(colorNo, colNo) = arDATA
            .Copy
      End With
      Sheets("Sample").Name = "¤µ¤éÁ`ªí(§¡­È±Æ§Ç) - " & Cat & "_²Î­p"
      On Error Resume Next
      Kill fpath & "\" & "¤µ¤éÁ`ªí(§¡­È±Æ§Ç)-" & Cat & "_²Î­p.xls"
      On Error GoTo 0
      
      ActiveWorkbook.Close savechanges:=True, Filename:=fpath & "\" & "¤µ¤éÁ`ªí(§¡­È±Æ§Ç)-" & Cat & "_²Î­p.xls"
      ReDim arDATA(colorNo, colNo)        'clear contents
      Application.ScreenUpdating = True
Return
End Sub

'To get all file names  into a working sheet
'=============================
Sub getFileNames()
      Dim fs, Cat$
      Dim sh As Worksheet
      Dim fpath$
      Dim i%, j%, R%
      
      fpath = ThisWorkbook.Path
      On Error Resume Next
      Set sh = Sheets("FileNameSh")
      If Err.Number <> 0 Then Sheets.Add.Name = "FileNameSh": Set sh = ActiveSheet
      On Error GoTo 0
      
      sh.Cells.Clear
      
      With sh
            fs = Dir(fpath & "\*.*")
            Do Until fs = ""
                 Cat = Left(Right(fs, 16), 12)
                 If InStr(Cat, "(2019") <> 0 Then
                        R = R + 1
                        .Cells(R, 1) = fs
                        .Cells(R, 2) = Cat
                  End If
                  fs = Dir
            Loop
            
            With .Sort
                  .SortFields.Add Key:=[B:B]
                  .SetRange sh.UsedRange
                  .Apply
            End With
      End With
End Sub

Airman

¦^´_ 17# Scott090
Scott090¤j¤j:±z¦n!
¤£¦n·N«ä¡A¦]¬°«á¨Ó¤~ª¾¹D¶Q¸ÑµªÀÉ¡F¥²¶·±N­n§PŪªº©Ò¦³ÀɮצWºÙ»P¤é´Á¡A¥þ³¡¥ýµn¿ý¦b"FileNameSh"ªºAÄæ©MBÄæ¤~¯à°õ¦æ¡A
©Ò¥H¥Ø«eÁÙ¦b¬ã¨s«ç»ò­×§ï?¼È®É¨S¦³¦A´ú¸Õ¤F^^"

­ã¤jªº¸ÑµªÀÉ¡A¦³¸Õ¹L200­ÓÀÉ®×~·Pı¬O1¤À¦hÄÁ~¦]¬°¨S¦³¥[¼g­p®É½X¡A©Ò¥H¤£ª¾¥¿½Tªº¯Ó®É¬O¦h¤Ö?^^

Airman

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

¤U¸ü (62.51 KB)

2019-5-5 17:17

¤U¸ü (60.48 KB)
¤µ¤éÁ`ªí(§¡­È±Æ§Ç)-(2019-04-09)_²Î­p

2019-5-5 17:19

­ã¤j¡J±z¦n!
¤£¦n·N«ä¡A¯à¦AÀ°¤p§Ì¥[¤@­Ó«ü©w¤é´Áªº¶}¼ú¸¹½X¶Ü^^"

»¡©ú¡J
·í²Î­pÀɮתº¤é´Á=DATAªºAÄæ¤é´Á®É¡A
«h±N²Î­pÀɮפºªº"Sample"¤u§@ªí¤§$B$1¡J$AX$1¦³¥X²{¸ÓAÄæ¤é´ÁªºD¡JJªº¼Æ¦r¼Ð¥Ü©³¦â~
=D¡JKªº¼Æ¦r¼Ð¥Ü6¸¹©³¦â¡F=Jªº¼Æ¦r¼Ð¥Ü43¸¹©³¦â¡C
¦p¸ÓDATAªºAÄæ¤é´ÁªºD¡JJ=""(§Y¨S¦³¥X²{¼Æ¦r)¡A«h³£¤£¼Ð¥Ü©³¦â¡C

PS¡J¦]¬°DATA©MÀɮצWºÙ¬O¥Ñ2­Ó¤£¦P³nÅé¤U¸üªº¡A©Ò¥H¤£¦P~
¦pªG³o¼Ë½s¼g·|«Ü³Â·Ð¡A´N½Ð±NDATAªºAÄæ¤é´Á®æ¦¡§ï¬°»P²Î­pÀɮצWºÙªº¤é´Á®æ¦¡¬Û¦P¡C

ÁÂÁ±z^^