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

[µo°Ý] ½Ð°Ý¦U¦ì¤j¤j ¦p¦ó ¦X¨Ö³øªí Á`©M²Î­p

[µo°Ý] ½Ð°Ý¦U¦ì¤j¤j ¦p¦ó ¦X¨Ö³øªí Á`©M²Î­p

¥»©«³Ì«á¥Ñ GBKEE ©ó 2015-11-16 07:36 ½s¿è

½Ð°Ý¦U¦ì¤j¤j    ¦p¦ó ¦X¨Ö³øªí Á`©M²Î­p

¤â¼g¤é³øªí »P ¹q¸£¤é³øªí »P ¶i³fªí ³£¬O ¥Î ¤â°Ê¿é¤Jªº¤è¦¡ ¶ñ¤J
¦Ó Á`©M²Î­pªí ¬O ±N  ¤â¼g¤é³øªí »P ¹q¸£¤é³øªí »P ¶i³fªí ªº¼Æ­È °µ ¥þ³¡ªº¥[Á`

¨Ì §Ç¸¹ ¥Ñ¤p¨ì¤j±Æ¦C , §e²{¤@¥÷³øªí
ÁÂÁ«ü¾É

Á`©M²Î­pªí.rar (2.97 KB)

owen

Sub TEST()
Dim j&, Jm&, Arr, Brr, xS As Worksheet, xD, N&
Sheets("Á`©M²Î­pªí").UsedRange.Offset(1, 0).ClearContents
¡@
ReDim Brr(1 To 6000, 1 To 8) '¡Ä°}¦C¹w³]®e¯Ç 6000 ¦C¡A¥i¦Û¦æ½Õ¾ã
Set xD = CreateObject("Scripting.Dictionary")
¡@
For Each xS In Sheets(Array("¤â¼g¤é³øªí", "¹q¸£¤é³øªí", "¶i³fªí"))
¡@¡@Arr = xS.UsedRange.Offset(1, 0).Value
¡@¡@For j = 1 To UBound(Arr)
¡@¡@¡@¡@Jm = xD(Arr(j, 1)):   If Arr(j, 1) = "" Then GoTo 99
¡@¡@¡@¡@If Jm = 0 Then N = N + 1: xD(Arr(j, 1)) = N: Jm = N
¡@¡@¡@¡@Brr(Jm, 1) = Arr(j, 1):    Brr(Jm, 2) = Arr(j, 2)
¡@¡@¡@¡@If xS.Name = "¶i³fªí" Then
¡@¡@¡@¡@¡@¡@Brr(Jm, 5) = Brr(Jm, 5) + Arr(j, 4) + Arr(j, 5) '¡ÄÁ`¶i³f
¡@¡@¡@¡@¡@¡@If InStr(" " & Brr(Jm, 6) & " ", " " & Arr(j, 6) & " ") = 0 Then  '¡Ä±Æ°£­«ÂÐ
¡@¡@¡@¡@¡@¡@¡@¡@Brr(Jm, 6) = Trim(Brr(Jm, 6) & " " & Arr(j, 6)) '¡Ä¬ö©À«~
¡@¡@¡@¡@¡@¡@End If
¡@¡@¡@¡@¡@¡@Brr(Jm, 8) = Trim(Brr(Jm, 8) & " " & Arr(j, 7)) '¡Ä³Æµù
¡@¡@¡@¡@Else
¡@¡@¡@¡@¡@¡@Brr(Jm, 3) = Brr(Jm, 3) + Arr(j, 4) '¡ÄÁ`±i¼Æ
¡@¡@¡@¡@¡@¡@Brr(Jm, 4) = Brr(Jm, 4) + Arr(j, 5) '¡ÄÁ`ªÑ¼Æ
¡@¡@¡@¡@¡@¡@Brr(Jm, 8) = Trim(Brr(Jm, 8) & " " & Arr(j, 6)) '¡Ä³Æµù
¡@¡@¡@¡@End If
¡@¡@¡@¡@Brr(Jm, 7) = Brr(Jm, 5) - Brr(Jm, 3) '¡ÄÁ`¶i³f-Á`±i¼Æ
99: Next
Next
¡@
If N = 0 Then Exit Sub
With [Á`©M²Î­pªí!A2:H2].Resize(N)
¡@¡@¡@.Value = Brr
¡@¡@¡@.Sort Key1:=.Item(1), Order1:=xlAscending, Header:=xlNo
End With
End Sub

µ{¦¡½X¬Ý°_¨Ó«Ü¦h, ¨ä¹ê³£¥u¬O[°Ñ·Ó¦ì¸m]¦Ó¤w, ½Ð¦Û¦æ¥hºCºC·N·|, ¤£¦h°µ»¡©ú¤F~~

TOP

·PÁ¤j¤j ªº«ü¾É
owen

TOP

        ÀR«ä¦Û¦b : ¯u¥¿ªº·R¤ß¡A¬O·ÓÅU¦n¦Û¤vªº³oÁû¤ß¡C
ªð¦^¦Cªí ¤W¤@¥DÃD