Board logo

標題: [發問] 大量資料篩選不重複並分類 [打印本頁]
作者: uf023630    時間: 2011-5-14 17:15     標題: 大量資料篩選不重複並分類

我遇到大量資料須要分開處理,想請大家幫忙
[attach]6168[/attach]
作者: diabo    時間: 2011-5-15 06:57

本帖最後由 diabo 於 2011-5-15 07:00 編輯
  1.    '問題1
  2.     end_row = Sheets("ASD1").[A65536].End(xlUp).Row
  3.     For Each aaa In Array("DL", "BA", "STOCK")
  4.         With Sheets("ASD1")
  5.             .Range("A1:C" & end_row).AutoFilter Field:=2, Criteria1:="=" & aaa
  6.             .Range("A1:C" & end_row).SpecialCells(xlCellTypeVisible).Copy
  7.              Sheets(aaa).Range("A1").PasteSpecial Paste:=xlPasteValues
  8.         End With
  9.     Next
複製代碼
作者: diabo    時間: 2011-5-15 07:00

記得在 VBE中設定引用項目勾選 Microsoft ActiveX Data Objects 2.x Library
  1.    '問題2
  2.     Dim strConn As String, strSQL As String
  3.     Dim conn As ADODB.Connection
  4.     Dim rs As ADODB.Recordset
  5.    
  6.     strConn = "Driver={Microsoft Excel Driver (*.xls)};" & _
  7.               "DBQ=" + ThisWorkbook.FullName + ";" & _
  8.               "ReadOnly=True"
  9.       
  10.     Set conn = CreateObject("ADODB.Connection")
  11.     Set rs = CreateObject("ADODB.Recordset")
  12.    
  13.     strSQL = "SELECT ITNO, SUM(TQT) AS TQT2 From ((SELECT ITNO,TQT FROM [ASD1$] WHERE LEN(WHS)=6 ORDER BY ITNO) tmpTable) GROUP BY ITNO"
  14.    
  15.     conn.Open strConn
  16.     rs.Open strSQL, conn, 3, 1
  17.    
  18.     With Sheets("BFTTL")
  19.         .Range("A2:B" & .[A65536].End(xlUp).Row).Cells.ClearContents
  20.         .Cells(2, 1).CopyFromRecordset rs
  21.     End With
  22.         
  23.     rs.Close
  24.     Set rs = Nothing
  25.    
  26.     conn.Close
  27.     Set conn = Nothing
複製代碼
作者: diabo    時間: 2011-5-15 07:01

看不懂問題3
作者: oobird    時間: 2011-5-15 16:53

問題3
  1. Sub yy()
  2.     Dim d As Object, a, b, i&, j%, k%, m%, n%
  3.     Set d = CreateObject("Scripting.Dictionary")
  4.     k = 1
  5.     With Sheets("ASD1")
  6.         a = .Range(.[a2], .[c65536].End(3))
  7.         ReDim b(1 To UBound(a), 1 To 3)
  8.         For i = 1 To UBound(a)
  9.             If Len(a(i, 2)) = 6 Then
  10.                 m = m + 1
  11.                 For j = 1 To 3
  12.                     b(m, j) = a(i, j)
  13.                 Next
  14.             End If
  15.         Next
  16.         Do
  17.             For i = 1 To m
  18.                 If b(i, 2) <> "" Then
  19.                     If Not d.exists(b(i, 1)) Then
  20.                         d(b(i, 1)) = Array(b(i, 1) & "", b(i, 2), b(i, 3))
  21.                         b(i, 2) = "": n = n + 1
  22.                     End If
  23.                 End If
  24.             Next
  25.             If d.Count > 0 Then
  26.                 Sheets("BF12").Cells(1, k).Resize(, 3) = .[a1:c1].Value
  27.                 Sheets("BF12").Cells(2, k).Resize(d.Count, 3) = Application.Transpose(Application.Transpose(d.items))
  28.                 d.RemoveAll
  29.                 k = k + 3
  30.             End If
  31.         Loop Until n = m
  32.     End With
  33. End Sub
複製代碼




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