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

¤½¥q¥Îªù¸T¨t²Î·í¦Ò¶Ô¡A¸ê®Æ»Ý­n¤H¤u¤ñ¹ï ³Â·Ð¡A»Ý­nÀ°§U

¤½¥q¥Îªù¸T¨t²Î·í¦Ò¶Ô¡A¸ê®Æ»Ý­n¤H¤u¤ñ¹ï ³Â·Ð¡A»Ý­nÀ°§U

½Ð±Ð¦U¦ì¥ý¶i:

¦pªG¤p§Ì¤âÃ䦳¥÷¥´¥d¸ê®Æ»Ý­n§@¤ñ¹ï ¦ý¬O¤H­û¥X¤Jªº®É¶¡¦³«D±`¦h­«ÂЮɶ¡

¦Ó§Ú¥u­n¬Ý·í¤Ñ²Ä1¦¸¨êªº ©M³Ì«á¤@¦¸¨êªº ¦p¦ó¤ñ¹ï¬d¬Ý??


¥H¤U¬°¤p§Ìªºexcel¦ì¸mÀÉ ÁÂÁÂ
https://docs.google.com/file/d/0B-xRp_Mu1bOQcG1jSFAzVHByZDg/edit?usp=sharing


1¤Ñ¤º ¥i¯à·|¦³5~8¦¸ªº¶i¥X°O¿ý¡A ©Ò¥H ±Æ§Ç¤§«á ÁÙ­n¤@­Ó¤@­Ó¤ñ¹ï «D±`¤H¤u¡A«D±`¶O®É¡C

¦³¤j¤j¯à«üÂI¤@¤U¶Ü ·PÁÂ

TOP

¥»©«³Ì«á¥Ñ GBKEE ©ó 2013-5-21 13:41 ½s¿è

¦^´_ 2# mack078
  1. Option Explicit
  2. Sub Ex()
  3.     Dim AR(), i As Integer, R As Long, A, D_Max As String, D_Min As String, xlDay As String
  4.     xlDay = Format(Date, "YYYYMMDD")
  5.     With Sheets("¨ê¥d¸ê®Æ®w")   ' ***  ½Ð­×§ï¬°§Aªº¤u§@ªí¦WºÙ   ***
  6.         .Range("A:A").AdvancedFilter xlFilterCopy, , .Cells(1, .Columns.Count), True
  7.                                                                     '¶i¶¥¿z¿ï       : AÄæ ¤£­«½Æ [­û¤u½s¸¹] ©ó¦¹¤u§@ªí³Ì¥kÄæ
  8.         R = .Cells(.Rows.Count, .Columns.Count).End(xlUp).Row       '¤u§@ªí³Ì¥kÄæ   : ³Ì«á¦C¦³¸ê®Æªº¦C¼Æ
  9.         If R = 1 Then Exit Sub                                      'R = 1          : ¨ê¥d¸ê®Æ®w¤¤¨S¸ê®Æ
  10.         ReDim AR(1 To .Cells(.Rows.Count, .Columns.Count).End(xlUp).Row)
  11.         AR(1) = Array("­û¤u½s¸¹", "©m¦W", "¨ê¥d¥d¸¹", "³¡ªù", "¾ºÙ", "¨ê¥d¤é´Á", "¤W¯Z®É¶¡", "¤U¯Z®É¶¡")
  12.         For i = 2 To .Cells(.Rows.Count, .Columns.Count).End(xlUp).Row
  13.             .Range("A1").AutoFilter 7, xlDay                        '¦Û°Ê¿z¿ï :²Ä7Äæ(¨ê¥d¤é´Á) ·Ç«h =xlDay
  14.             .Range("A1").AutoFilter 1, .Cells(i, .Columns.Count)    '¦Û°Ê¿z¿ï :²Ä1Äæ(ID)       ·Ç«h =¤u§@ªí³Ì¥kÄ檺I¦C
  15.             
  16.             R = .[A1].End(xlDown).Row
  17.             If R <> .Rows.Count Then                                '¦³¿z¿ï¨ì¸ê®Æ: ³Ì«á¤@¦Cªº¦C¸¹ <> Rows.Count=Àɮ׳̳̫á¤@¦Cªº¦C¸¹
  18.                 D_Min = Application.Min(Sheet1.Range("H:H").SpecialCells(xlCellTypeVisible))
  19.                                                                     'SpecialCells(xlCellTypeVisible):¥i¨£Àx¦s®æ
  20.                 D_Max = Application.Max(Sheet1.Range("H:H").SpecialCells(xlCellTypeVisible))
  21.                 If D_Min = D_Max Then D_Max = " "
  22.                 A = .Range("A" & R).Resize(1, 8)                    '¿z¥Xªº¸ê®Æ³Ì«á¤@¦C¤§8Äæ½d³ò³]¬°°}¦C¤¸¯À
  23.                 A(1, 6) = xlDay                                     '­×§ï ¤¸¯Àªº­È
  24.                 A(1, 7) = D_Min
  25.                 A(1, 8) = D_Max
  26.             Else         ' xlDay ªº¨ê¥d®É¶¡ ¨S¿z¿ï¨ì¸ê®Æ: = Rows.Count=Àɮ׳̳̫á¤@¦Cªº¦C¸¹
  27.                 .Range("A1").AutoFilter 7                           '¤£³]©w²Ä7Äæ(¨ê¥d¤é´Á)ªº·Ç«h
  28.                 R = .[A1].End(xlDown).Row
  29.                 A = .Range("A" & R).Resize(1, 8)                    '¿z¥Xªº¸ê®Æ³Ì«á¤@¦C¤§8Äæ½d³ò³]¬°°}¦C¤¸¯À
  30.                 A(1, 6) = xlDay                                     '­×§ï ¤¸¯Àªº­È
  31.                 A(1, 7) = ""
  32.                 A(1, 8) = ""
  33.                
  34.             End If
  35.             AR(i) = A                                               '­×§ï ¤¸¯Àªº­È
  36.         Next
  37.         .AutoFilterMode = False                                     '¨ú®ø ¦Û°Ê¿z¿ï :¨ê¥d¸ê®Æ®w,¸ê®Æ¥þ³¡Åã¥Ü.
  38.     End With
  39.     With Sheets("¬d¸ß").[A1] ' ***  ½Ð­×§ï¬°§Aªº¤u§@ªí¦WºÙ   ***
  40.                                                                     '·í¤é¨ê¥d®É¶¡¸ê®Æ,¸m©ó¥t¤@¤u§@ªí.[A1]
  41.         .CurrentRegion = ""                                         '²M°£Â¦³¨ê¥d®É¶¡
  42.         .Resize(i - 1, UBound(AR) - 1).Value = Application.Transpose(Application.Transpose(AR))   'Âà¸mAR°}¦C©ó½d³ò¤¤
  43.     End With
  44. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¤]³\¥i¦Ò¼{¼Ï¯Ã¤ÀªRªí¡G
http://www.funp.net/841064

TOP

¥»©«³Ì«á¥Ñ stillfish00 ©ó 2013-5-21 20:25 ½s¿è

ÁÙ¦³¥t¤@ºØ...±q¥~³¡¸ê®ÆªºMicrosoft Query¹ï¤u§@ªí¬d¸ß
¤£¹L­nµy·LÀ´SQL»yªk¡A©³¤U¬O¿ý»s«á­×§ïªºVBA µ{¦¡

Sub ExcelQuery()
    Dim sSQL, driverID As Long
   
    driverID = 1046 'Excel2010:1046 ; Excel2003:790
    sSQL = Array("SELECT `Sheet4$`.­û¤u½s¸¹, `Sheet4$`.©m¦W, `Sheet4$`.¨ê¥d¥d¸¹, `Sheet4$`.³¡ªù, `Sheet4$`.¾ºÙ, `Sheet4$`.¨ê¥d¤é´Á, " _
            , "Min(`Sheet4$`.¨ê¥d®É¶¡) AS ¤W¯Z®É¶¡, Max(`Sheet4$`.¨ê¥d®É¶¡) AS ¤U¯Z®É¶¡" _
            , " FROM `" & ThisWorkbook.FullName & "`.`Sheet4$` `Sheet4$`" _
            , " GROUP BY `Sheet4$`.­û¤u½s¸¹, `Sheet4$`.©m¦W, `Sheet4$`.¨ê¥d¥d¸¹, `Sheet4$`.³¡ªù, `Sheet4$`.¾ºÙ, `Sheet4$`.¨ê¥d¤é´Á" _
           )

    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
        "ODBC;DSN=Excel Files;DBQ=" & ThisWorkbook.FullName, _
        ";DefaultDir=" & ThisWorkbook.Path, _
        ";DriverId=" & driverID, _
        ";MaxBufferSize=2048;PageTimeout=5;") _
        , Destination:=Range("$A$1")).QueryTable
        .CommandText = Array(sSQL)
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "MS_QUERY_³s½u"
        .Refresh BackgroundQuery:=False
        '¤£«O«ù³s½u
        .Delete
    End With
End Sub

TOP

        ÀR«ä¦Û¦b : ¬°¦Û¤v§äÂǤfªº¤H¥Ã»·¤£·|¶i¨B¡C
ªð¦^¦Cªí ¤W¤@¥DÃD