p6703

¦pªþ¥ó¨C¤é·|¦³¸ê®Æ¶ñ©óSheet¤W¡A¥i§_¨Ï¥ÎVBA±N¸ê®Æ®M¨ú©óSheet2¤Wªºªí®æ®æ¦¡¡AÀµ½Ð¦U¦ì°ª¤â±Ð¾É¡A¦b¦¹¥ýÁÂÁÂ:)

¥D­n¨Ì"¥æ´Á"Äæ¦ì·|¦³¤À¦hµ§¡A©ó»Ý¨D¤é»Ý¥[Á`¦P­q³æ¼Æ¡A¦Ó¥æ´ÁÄæ¦ì¦U§O¤ñ¹ï¨ä¹ïÀ³ªº²Å¦X¤é´ÁÄæ¦ì

Book1.rar (2.03 KB)

¤U¸ü¦¸¼Æ: 25

2012-4-24 23:35

register313

¦^´_ 1# p6703


¬Ý¤£À´¦p¦ó¹ïÀ³? ¦p¦ó¶ñ¤Jsheet2?
µ¹­Ó½d¨Ò ¶ñ¤Jexcelªí¤º ¸û©ö¤F¸Ñ

c_c_lai

¦^´_ 2# register313
¥Lªº·N«äÀ³¸Ó¬O¡G

¤U¸ü (20.39 KB)

2012-4-25 06:44

p6703

·PÁÂc_c_lai ¥Sªº¸É¥R»¡©ú¡Aªº½T¦¹´N¬O¤p§Ì©Ò·Q­nªº¥\¯à

¦ý¦AÃB¥~¸É¥R»¡©ú¤@¤U,´N¦p²Å¥ó¤¤ªºSheet1¤Wªº­q³æ¸ê®Æ¡A¨ä¹ê¦³¤Tµ§¬O­«ÂЪº¡]¦]¥æ´Á¦]¯À§â¥¦©î¶}¨Ó¡^¡A¦ý®M¨ìSheet2®É­n¶×¾ã¦¨¤@¶µ¡]»Ý¨D¼Æ¥[Á`¡A¨Ã¨Ì¥æ´Á¼Æ¤À§O®M¦b¹ïÀ³ªº¤é´Á¤W¡^

register313

¦^´_ 4# p6703

µ{¦¡»yªk¤£²z·Q,©|¦³§ï¶iªÅ¶¡,½Ð«ü¥¿

1. Sub zz()
   
2. Set d = CreateObject("scripting.dictionary")
   
3. With Sheet1
   
4.   ar = .Range("A2:F" & .[F2].End(xlDown).Row)
   
5.   For i = 1 To UBound(ar)
   
6.     x = ar(i, 1) & "," & ar(i, 2) & "," & ar(i, 3)
   
7.     If Not d.exists(x) Then d.Add x, ar(i, 4) Else d(x) = d(x) + ar(i, 4)
   
8.   Next i
   
9. End With
   
10. a = d.keys: b = d.items
    
11. c = 0
    
12. With Sheet2
    
13.   .[A1].CurrentRegion.Offset(1, 0) = ""
    
14.   For i = 0 To d.Count - 1
    
15.     y = Split(a(i), ",")
    
16.     .Range("A2").Offset(c, 0).Resize(1, 3) = y
    
17.     .Range("D2").Offset(c, 0).Resize(2, 1) = Application.Transpose(Array("»Ý¨D¤é", "¥æ´Á"))
    
18.     For j = 2 To Sheet1.[A2].End(xlDown).Row
    
19.       x = Sheet1.Cells(j, 1) & "," & Sheet1.Cells(j, 2) & "," & Sheet1.Cells(j, 3)
    
20.       If a(i) = x Then
    
21.         E = Application.Match(Sheet1.Cells(j, 5), .Range(.[E1], .[E1].End(xlToRight)), 0)
    
22.         .Range("E2").Offset(c, E - 1) = d(x)
    
23.         F = Application.Match(Sheet1.Cells(j, 6), .Range(.[E1], .[E1].End(xlToRight)), 0)
    
24.         .Range("E3").Offset(c, F - 1) = Sheet1.Cells(j, 4)
    
25.       End If
    
26.     Next j
    
27.     c = c + 2
    
28.   Next i
    
29. End With
    
30. End Sub

½Æ»s¥N½X

p6703

·PÁÂregister313¥S«ü±Ð¡A¦ý¤p§Ì±Nµ{¦¡½X½Æ»s°õ¦æ¥¨¶°®É¡A«o¶]¥X"°õ¦æ¶¥¬q¿ù»~ '424': ¦¹³B»Ý­nª«¥ó"ªºÄµ§iµøµ¡¡A°±¦b.[A1].CurrentRegion.Offset(1, 0) = ""¦¹¦C¡A¤£ª¾¦ó¬G???

register313

¦^´_ 6# p6703

p6703

·PÁÂregister313¥S¡A¥i¥H°õ¦æ¤F¡A¦ý¤p§Ì¤£©ú¥Õ¡Aµ{¦¡½X¤@¼Ë¡A¦]¦ó¤p§Ì¦Û¤v½Æ»s¶K¤Wªº´N¤£¦æ©O???ÁÙ¦³¤p§Ì±µÄ²vba¤£¤[¡A¤£ª¾¬O§_¥i½Ðregister313¥S°w¹ïµ{¦¡½X¤p¤p»¡©ú¤@¤U¡AÁÂÁÂ...

p6703

¤p§Ì¥ýºN¯Á¬Ý¬Ý¤F.¦A¦¸·PÁÂregister313¥S^^

Hsieh

¦^´_ 4# p6703

1. Sub Ex()
   
2. Dim A As Range
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. With Sheet2
   
5. n = .Cells(1, .Columns.Count).End(xlToLeft).Column - 1
   
6. s = Day(.[E1])
   
7. With Sheet1
   
8.    For Each A In .Range(.[A2], .[A2].End(xlDown))
   
9. ReDim ar(0 To 1, 0 To n)
   
10.        m = A & "," & A.Offset(, 1) & "," & A.Offset(, 2)
    
11.        If IsEmpty(d(m)) Then
    
12.        GoTo 10
    
13.        Else
    
14.        For i = 0 To 1
    
15.          For j = 0 To n
    
16.            ar(i, j) = d(m)(i, j)
    
17.          Next
    
18.        Next
    
19.        End If
    
20. 10
    
21.        x = Day(A.Offset(, 4)) - s + 4 '»Ý¨D¤é
    
22.        y = Day(A.Offset(, 5)) - s + 4 '¥æ´Á
    
23.        For i = 0 To 2
    
24.          ar(0, i) = A.Offset(, i)
    
25.        Next
    
26.        ar(0, 3) = "»Ý¨D¤é"
    
27.        ar(1, 3) = "¥æ´Á"
    
28.        ar(0, x) = ar(0, x) + A.Offset(, 3) '»Ý¨D
    
29.        ar(1, y) = A.Offset(, 3)
    
30.        d(m) = ar
    
31.        Erase ar
    
32.    Next
    
33. End With
    
34. r = 2
    
35. For Each ky In d.keys
    
36.   .Cells(r, 1).Resize(2, n + 1) = d(ky)
    
37.   r = r + 2
    
38. Next
    
39. End With
    
40. End Sub

½Æ»s¥N½X