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

[µo°Ý] ¤j¶q¸ê®Æ¿z¿ï¤£­«½Æ¨Ã¤ÀÃþ

[µo°Ý] ¤j¶q¸ê®Æ¿z¿ï¤£­«½Æ¨Ã¤ÀÃþ

§Ú¹J¨ì¤j¶q¸ê®Æ¶·­n¤À¶}³B²z,·Q½Ð¤j®aÀ°¦£
°ÝÃD.rar (14.17 KB)

¥»©«³Ì«á¥Ñ diabo ©ó 2011-5-15 07:00 ½s¿è
  1.    '°ÝÃD1
  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
½Æ»s¥N½X
diabo

TOP

°O±o¦b VBE¤¤³]©w¤Þ¥Î¶µ¥Ø¤Ä¿ï Microsoft ActiveX Data Objects 2.x Library
  1.    '°ÝÃD2
  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
½Æ»s¥N½X
diabo

TOP

¬Ý¤£À´°ÝÃD3
diabo

TOP

°ÝÃD3
  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
½Æ»s¥N½X

TOP

        ÀR«ä¦Û¦b : ¤â¤ß¦V¤U¬O§U¤H¡A¤â¤ß¦V¤W¬O¨D¤H¡F§U¤H§Ö¼Ö¡A¨D¤Hµh­W¡C
ªð¦^¦Cªí ¤W¤@¥DÃD