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

[µo°Ý] ½Ð°Ý¨Ó·½¸ê®Æ¦Û°Ê§P©w®É¶¡¿é¤J¬ÛÀ³ªºsheet¤º

[µo°Ý] ½Ð°Ý¨Ó·½¸ê®Æ¦Û°Ê§P©w®É¶¡¿é¤J¬ÛÀ³ªºsheet¤º

¦U¦ì«e½ú¤Î¤j¤j­Ì¦n
¤p§Ì¦³­Ó°ÝÃD

¦³¨â­Ó¨Ó·½Àɸê®Æ­n¶×¤J¬ÛÀ³ªº¤u§@ªí¤¤


¨Ó·½Àɪº¤¤ªº1¡B2©MB2~M2¡BB38~M38¡BB74~M74.....©ïÀY¦WºÙ©M¥ØªºÀÉ3ªºB4~BT4©ïÀY¦WºÙ¬Û¦P¦ý"¤u§@ªí"¤£¦P

¥ØªºÀɪº®É¶¡ÂI­n§ì¨ú¨Ó·½ÀɪºN2«á¶×¤J»Ý­nªº®É¶¡ÂI¡A¥Ñ©ó¨Ó·½ÀɨC¦¸ÀɦW·|¤£¦P¦ý®æ¦¡¬Û¦P

¨Ó·½ÀɶפJ¥ØªºÀɩһݸê®Æ«á¤U¦¸¸ê®Æ¶×¤J·|±q¤U¤@¦C¥H¦P¼Ëªº¤èªk§@·~


Daily Report.rar (445.97 KB)

¥»©«³Ì«á¥Ñ stillfish00 ©ó 2013-12-4 23:26 ½s¿è

¦^´_ 1# rockrun
©ïÀY¦WºÙ©M¥ØªºÀɤ£¦P©O¡A¹³B38 ©Î B74 ....

TOP

¥»©«³Ì«á¥Ñ rockrun ©ó 2013-12-4 23:33 ½s¿è

¦^´_ 2# stillfish00


    ©êºp©êºp ¤p§Ì²´®À  ¨C¤ëkeyin¨º»ò¤[«o¨Sµo²{ :dizzy:

Daily Report.rar (446.64 KB)

TOP

¦^´_ 3# rockrun
  1. Sub Test()
  2.     Dim sFile, wbThis As Workbook, wbSrc As Workbook
  3.     Dim lRowIndex As Long, lColIndex As Long, oDic As Object, aTime, sDate
  4.     Dim sType As String, lShIndex As Long
  5.         
  6.     Const lBlkWidth As Long = 13
  7.     Const lBlkHeight As Long = 36
  8.    
  9.     sFile = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls),*.xls", Title:="¿ï¾ÜÀÉ®×")
  10.     If StrComp(TypeName(sFile), "Boolean", vbTextCompare) = 0 Then Exit Sub
  11.         
  12.     Application.ScreenUpdating = False
  13.     Set wbThis = ThisWorkbook
  14.     Set wbSrc = Workbooks.Open(Filename:=sFile, ReadOnly:=True)
  15.     Set oDic = CreateObject("Scripting.Dictionary")
  16.    
  17.     With wbSrc.Sheets(1)
  18.         sDate = .Range("TitleDate").Value
  19.         aTime = .[A6].Resize(24).Value
  20.         For lRowIndex = .[A2].Row To .UsedRange.Rows.Count Step lBlkHeight
  21.             For lColIndex = 2 To lBlkWidth
  22.                 sType = .Cells(lRowIndex, lColIndex).Value
  23.                 If sType <> "" And Left(sType, 1) <> "@" Then
  24.                     oDic(sType) = .Cells(lRowIndex, lColIndex).Offset(4).Resize(24).Value
  25.                 End If
  26.             Next
  27.         Next
  28.     End With
  29.     wbSrc.Close
  30.     Application.ScreenUpdating = True
  31.    
  32.     With wbThis
  33.         For lShIndex = 1 To .Sheets.Count
  34.             With .Sheets(lShIndex)
  35.                 lRowIndex = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
  36.                 .Cells(lRowIndex, "A").Value = sDate
  37.                 .Cells(lRowIndex, "B").Resize(24) = aTime
  38.                 For lColIndex = 3 To .[C4].End(xlToRight).Column
  39.                     If oDic.exists(.Cells(4, lColIndex).Value) Then
  40.                         .Cells(lRowIndex, lColIndex).Resize(24).Value = oDic(.Cells(4, lColIndex).Value)
  41.                         oDic.Remove .Cells(4, lColIndex).Value
  42.                     End If
  43.                 Next
  44.             End With
  45.         Next
  46.     End With
  47.    
  48.     MsgBox "¥Ø¼ÐÀɧ䤣¨ìÄæ¦ìªº¸ê®Æ: " & vbCrLf & Join(oDic.keys, ", ")
  49. End Sub
½Æ»s¥N½X

TOP

¦^´_ 4# stillfish00

«D±`·PÁ stillfish00 ¤j¤jªºÀ°¦£

¦pªG­n¨ú©T©w®É¶¡­Èªº¸Ü¸Ó«ç»ò°µ(¦p 00:00¡B04:00¡B08:00¡B......¤§Ãþ)

TOP

¦^´_ 5# rockrun
¸Õ¸Õ¬Ý
  1. Sub Test()
  2.     Dim sFile, wbThis As Workbook, wbSrc As Workbook
  3.     Dim lRowIndex As Long, lColIndex As Long, oDic As Object, aTime, sDate
  4.     Dim sType As String, lShIndex As Long, lTimeIndex As Long
  5.         
  6.     Const lBlkWidth As Long = 13
  7.     Const lBlkHeight As Long = 36
  8.    
  9.     sFile = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls),*.xls", Title:="¿ï¾ÜÀÉ®×")
  10.     If StrComp(TypeName(sFile), "Boolean", vbTextCompare) = 0 Then Exit Sub
  11.    
  12.     aTime = InputBox("¿é¤J­n°O¿ýªº®É¶¡" & "(¥H³r¸¹¤À¶}¡A¤£­nªÅ®æ)", , "00:00,04:00,08:00")
  13.     If aTime = "" Then Exit Sub
  14.     aTime = Split(aTime, ",")
  15.         
  16.     Application.ScreenUpdating = False
  17.     Set wbThis = ThisWorkbook
  18.     Set wbSrc = Workbooks.Open(Filename:=sFile, ReadOnly:=True)
  19.     Set oDic = CreateObject("Scripting.Dictionary")
  20.    
  21.     With wbSrc.Sheets(1)
  22.         sDate = .Range("TitleDate").Value
  23.         For lRowIndex = .[A2].Row To .UsedRange.Rows.Count Step lBlkHeight
  24.             For lColIndex = 2 To lBlkWidth
  25.                 sType = .Cells(lRowIndex, lColIndex).Value
  26.                 If sType <> "" And Left(sType, 1) <> "@" Then
  27.                     If Not oDic.exists(sType) Then
  28.                       Set oDic(sType) = CreateObject("scripting.dictionary")
  29.                       For Each x In .Cells(lRowIndex, 1).Offset(4).Resize(24)
  30.                         If x.Value <> "" Then oDic(sType)(x.Text) = x.Offset(, lColIndex - 1).Value
  31.                       Next
  32.                     End If
  33.                 End If
  34.             Next
  35.         Next
  36.     End With
  37.     wbSrc.Close
  38.     Application.ScreenUpdating = True
  39.    
  40.     With wbThis
  41.         For lShIndex = 1 To .Sheets.Count
  42.             With .Sheets(lShIndex)
  43.                 lRowIndex = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
  44.                 .Cells(lRowIndex, "A").Value = sDate
  45.                 .Cells(lRowIndex, "B").Resize(UBound(aTime) + 1) = Application.Transpose(aTime)
  46.                 For lColIndex = 3 To .[C4].End(xlToRight).Column
  47.                     If oDic.exists(.Cells(4, lColIndex).Value) Then
  48.                         For lTimeIndex = 0 To UBound(aTime)
  49.                           .Cells(lRowIndex, lColIndex).Offset(lTimeIndex).Value = oDic(.Cells(4, lColIndex).Value)(aTime(lTimeIndex))
  50.                         Next
  51.                         oDic(.Cells(4, lColIndex).Value).RemoveAll
  52.                         oDic.Remove .Cells(4, lColIndex).Value
  53.                     End If
  54.                 Next
  55.             End With
  56.         Next
  57.     End With
  58.    
  59.     MsgBox "¥Ø¼ÐÀɧ䤣¨ìÄæ¦ìªº¸ê®Æ: " & vbCrLf & Join(oDic.keys, ", ")
  60.     'cleanup
  61.     For Each x In oDic
  62.       oDic(x).RemoveAll
  63.       oDic.Remove
  64.     Next
½Æ»s¥N½X

TOP

¦^´_ 6# stillfish00

·PÁ stillfish00 ¤j¤jªºÀ°¦£

¤j­P°ÝÃD³£¸Ñ¨M¤F¡A«D±`·PÁÂ:'(

TOP

        ÀR«ä¦Û¦b : ±o²z­nÄǤH¡A²zª½­n®ð©M¡C
ªð¦^¦Cªí ¤W¤@¥DÃD