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

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

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

¥»©«³Ì«á¥Ñ marklos ©ó 2012-1-16 21:24 ½s¿è

½Ð°Ý¦p¦ó±N¬Û¦Pªº¸ê®Æ§@¾ã¦C¼Æ¾Úªº¦X¨Ö~¸Ô²Ó»Ý¨D¦p¤U
2012-01-15_130311.jpg
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¨Ö
2012-01-15_130504.jpg
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)
·Ð½Ð°ª¤H«üÂI~
ÁÂÁÂ~

¦^´_ 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

TOP

¦^´_ 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
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 2# register313


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

·P®¦~

TOP

¦^´_ 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

TOP

¦^´_ 5# register313


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

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