Board logo

標題: [發問] 請問高手如何篩選第一筆及最後一筆 [打印本頁]
作者: anotny    時間: 2010-8-30 21:39     標題: 請問高手如何篩選第一筆及最後一筆

公司有一些卡鐘資料
例如:20100826,0827,1234
       20100826,0844,3586
      20100826,1844,7896
文字檔,我要如何寫一個VBA自動篩選器,篩選文字檔每個人第一筆及最後一筆資料,讓我家小姐用,請高手指點小弟謝謝!!
作者: kimbal    時間: 2010-8-31 00:41

公司有一些卡鐘資料
例如:20100826,0827,1234
       20100826,0844,3586
      20100826,1844,7896
文 ...
anotny 發表於 2010-8-30 21:39


方法有很多, 這個是選上文檔直接匯入
  1.    
  2. sub test()
  3. Dim filename As String

  5.     With Application.FileDialog(msoFileDialogOpen)
  6.         .AllowMultiSelect = False
  7.         .Show
  8.         If .SelectedItems.Count > 0 Then
  9.             filename = .SelectedItems(1)
  10.         Else
  11.             Exit Sub
  12.         End If
  13.     End With

  15.    
  16.     Dim oFSO
  17.     Set oFSO = CreateObject("Scripting.FileSystemObject")
  18.     Set sdmax = CreateObject("Scripting.Dictionary")
  19.     Set sdmin = CreateObject("Scripting.Dictionary")

  21.     Dim strDate As String
  22.     Dim strTime As String
  23.     Dim strNo As String
  24.     Set oFS = oFSO.OpenTextFile(filename)

  26.     Do Until oFS.AtEndOfStream
  27.         sText = oFS.ReadLine
  28.         strDate = Split(sText, ",")(0)
  29.         strTime = Split(sText, ",")(1)
  30.         strNo = Split(sText, ",")(2)
  31.         
  32.         If sdmin.exists(strNo) Then
  33.             sdmax(strNo) = strTime
  34.         Else
  35.             sdmin.Add strNo, strTime
  36.             sdmax.Add strNo, strTime
  37.         End If
  38.         
  39.     Loop
  40.    
  41.     Range("A1").Resize(sdmin.Count, 1).Value = Application.Transpose(sdmin.keys)
  42.     Range("B1").Resize(sdmin.Count, 1).Value = Application.Transpose(sdmin.items)
  43.     Range("C1").Resize(sdmin.Count, 1).Value = Application.Transpose(sdmax.items)
  44.     Set sdmin = Nothing
  45.     Set sdmax = Nothing
  46.     oFS.Close
  47.     oFSO = Null
  48. end sub
複製代碼




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)