[µo°Ý] ¦p¦ó±N¬Û¦Pªº¸ê®Æ°µ¾ã¦C¼Æ¾Úªº¦X¨Ö¤Î¥[Á`

marklos

½Ð°Ý¦p¦ó±N¬Û¦Pªº¸ê®Æ§@¾ã¦C¼Æ¾Úªº¦X¨Ö~¸Ô²Ó»Ý¨D¦p¤U

¤U¸ü (87.5 KB)

2012-1-16 21:19

Sheet1 «Ý³B²z¤u§@ªí
±N¬õ¦â¼Ð¥Ü¤º"F"Äæ¦ì¤º¼Æ¶q¬°"0"ªº, °µ¾ã¦C§R°£
±N¶À¦â¼Ð¥Ü¤º"F"Äæ¦ì¤º¼Æ¶q¤£¬°"0"ªÌ , «O¯d
±NÂo¦â¼Ð¥Ü¤º"A"Äæ¦ì¤º¸ê®Æ¬Û¦PªÌ , °µ¦X¨Ö

¤U¸ü (57.87 KB)

2012-1-16 21:19

Sheet2µ²ªG¤u§@ªí, »Ý¨Dµ²ªG¦p¤W¹Ï©Ò¥Ü
"F"Äæ¦ì¤º¼Æ¶q¬°"0"ªº, ¾ã¦C§R°£
­ì¥»"A6&A7" ¬Û¦P¸ê®ÆªºÄæ¦ì , ¨ä"D"&"G" ¨â­ÓÄæ¦ì¸ê®Æ§@¦X¨Ö
, "F" Äæ¦ì¤ºªº¼Æ¶q³¡¥÷°µ¥[Á`.
QQ2.rar (2.21 KB)

¤U¸ü¦¸¼Æ: 30

2012-1-16 21:20

·Ð½Ð°ª¤H«üÂI~
ÁÂÁÂ~

register313

¦^´_ 1# marklos

ªì¾ÇªÌVBA

1. Sub QQ()
   
2. LastRow = [A65535].End(xlUp).Row
   
3. For R = LastRow To [A1].Row Step -1
   
4.   If Cells(R, "F") = 0 Then
   
5.      Rows(R).Delete Shift:=xlUp
   
6.   End If
   
7.   If R = 1 Then Exit For
   
8.   If Cells(R, "A") & Cells(R, "B") & Cells(R, "C") = Cells(R - 1, "A") & Cells(R - 1, "B") & Cells(R - 1, "C") Then
   
9.      Cells(R - 1, "D") = Cells(R - 1, "D") & "/" & Cells(R, "D")
   
10.      Cells(R - 1, "F") = Cells(R - 1, "F") + Cells(R, "F")
    
11.      Cells(R - 1, "G") = Cells(R - 1, "G") & "," & Cells(R, "G")
    
12.      Rows(R).Delete Shift:=xlUp
    
13.   End If
    
14. Next
    
15. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 1# marklos

1. Sub ex()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. With ¤u§@ªí1
   
4. For Each a In .Range(.[A1], .[A1].End(xlDown))
   
5. If a.Offset(, 6) <> 0 Then
   
6.   If IsEmpty(d(a.Value)) Then
   
7.      d(a.Value) = Application.Transpose(Application.Transpose(a.Resize(, 9).Value))
   
8.      Else
   
9.      ar = d(a.Value)
   
10.      ar(4) = ar(4) & "/" & a.Offset(, 3).Value
    
11.      ar(6) = ar(6) + a.Offset(, 5).Value
    
12.      ar(7) = ar(7) & "," & a.Offset(, 6).Value
    
13.      d(a.Value) = ar
    
14.    End If
    
15. End If
    
16. Next
    
17. End With
    
18. With ¤u§@ªí2
    
19. .Cells = ""
    
20. .[A1].Resize(d.Count, 9) = Application.Transpose(Application.Transpose(d.items))
    
21. End With
    
22. End Sub

½Æ»s¥N½X

marklos

¦^´_ 2# register313


    ·PÁ±zªºÀ°¦£~~
¦ý¬OÁÙ¦³¤@¨Æ¥¼©ú
¨ä¤¤"G"Äæ¦ì¸ê®Æ§@¦X¨Ö¤§«á , ¬O§_¥i¥H¦A¥[¥H±Æ§Ç?

·P®¦~

register313

¦^´_ 4# marklos
¦^´_ 4# GBKEE

·PÁÂGBKEE§¹¦¨­×§ï

1. Sub QQ()
   
2. LastRow = [A65535].End(xlUp).Row
   
3. For RR = LastRow To [A1].Row Step -1
   
4.   If Cells(RR, "F") = 0 Then
   
5.      Rows(RR).Delete Shift:=xlUp
   
6.   End If
   
7.   If RR = 1 Then Exit For
   
8.   If Cells(RR, "A") & Cells(RR, "B") & Cells(RR, "C") = Cells(RR - 1, "A") & Cells(RR - 1, "B") & Cells(RR - 1, "C") Then
   
9.      Cells(RR - 1, "D") = Cells(RR - 1, "D") & "/" & Cells(RR, "D")
   
10.      Cells(RR - 1, "F") = Cells(RR - 1, "F") + Cells(RR, "F")
    
11.      Cells(RR - 1, "G") = Cells(RR - 1, "G") & "," & Cells(RR, "G")
    
12.      Rows(RR).Delete Shift:=xlUp
    
13.   End If
    
14. Next
    
15. Dim Rng As Range, Ar, xL As Integer, xW As String, R As Range
    
16. Set Rng = Sheets("Sheet1").[G1]
    
17. Do
    
18.     xW = ""
    
19.     If InStr(Rng, ",") Then
    
20.         For xL = 1 To Len(Rng)
    
21.             If Mid(Rng, xL, 1) Like "[A-z]" Then xW = xW & Mid(Rng, xL, 1) Else Exit For
    
22.         Next
    
23.         Ar = Split(Rng, ",")
    
24.         With [IV1].Resize(UBound(Ar) + 1)
    
25.             .Value = Application.Transpose(Ar)
    
26.             .Cells.Replace xW, ""
    
27.             .Sort Key1:=Range("IV1"), Order1:=xlAscending, Header:=xlNo
    
28.             For Each R In .Cells
    
29.                 R = xW & R
    
30.             Next
    
31.             Rng = Join(Application.Transpose(.Value), ",")
    
32.             .Value = ""
    
33.         End With
    
34.     End If
    
35.     Set Rng = Rng.Offset(1)
    
36. Loop Until Rng(1) = ""
    
37. End Sub

½Æ»s¥N½X

marklos

¦^´_ 5# register313


    ·PÁ±zªº¤j¤OÀ°¦£~~°ÝÃD¤w¸g¸Ñ¨M¤F!!!:P