[µo°Ý] °õ¦æ¶¥¬q¿ù»~13

jesscc

¤w¸gªñ¤@­Ó¬P´Á¤F¡A§Ú²ª½­n³Q³o­Ó "°õ¦æ¶¥¬q¿ù»~13"·d±o§ÖºÆ¤F¡A¤@ª½¤£Â_¦a­×§ïµ{¦¡½X¡A¦ý¬O¿ù»~¤@ª½¤£«È®ð¦a¥X²{¡A½Ð¦U¦ì±Ï±Ï§Ú§a!
¥H¤U¬Oµ{¦¡½X¡A¬õ¦r¬O¥X²{°»¿ùªº³¡¤À¡AªþÀɸ̥t¦³¸Ô²Ó»¡©ú

Sub C_MERGE()
If [T7] = "" Then Exit Sub
[X7:AG100].ClearContents
Dim cRow&, T As Range

Set d = CreateObject("Scripting.Dictionary") '¤¤¤å«~¶µ¦X¨Ö
For Each T In Range([T7], [T300].End(xlUp))
   If d(T.Value) = "" Then '¦pªGTÄæ¸ê®Æ¥u¦³¤@µ§¤£­«½Æ
      d(T.Value) = T.Offset(, -6) & " " & T.Offset(, -4) & " " & T.Offset(, -3)
      Else
      d(T.Value) = d(T.Value) & ", " & T.Offset(, -6) & " " & T.Offset(, -4) & " " & T.Offset(, -3)

    End If
Next
[Y7].Resize(d.Count, 1) = Application.Transpose(d.keys)
[AF7].Resize(d.Count, 1) = Application.Transpose(d.items)
Set d = Nothing

'--------------------------
Set d1 = CreateObject("Scripting.Dictionary") '­^¤å«~¶µ¦X¨Ö
For Each T In Range([T7], [T300].End(xlUp))
If T.Offset(, 2) = "" Then GoTo AA
   If d1(T.Value) = "" Then
      d1(T.Value) = T.Offset(, -5) & " " & T.Offset(, 2) & " " & T.Offset(, -3)
      Else
      d1(T.Value) = d1(T.Value) & ", " & T.Offset(, -5) & " " & T.Offset(, 2) & " " & T.Offset(, -3)
    End If
AA: Next

[AG7].Resize(d1.Count, 1) = Application.Transpose(d1.items)
Set d1 = Nothing

cRow = Range("Y100").End(xlUp).Row
     If cRow < 7 Then Exit Sub
     Range("X7:X" & cRow).Formula = "=VLOOKUP(Y7,T:U,2,FALSE)"
     Range("Z7:Z" & cRow).Formula = "=COUNTIF(T$7:T$490,Y7)"
     Range("AA7:AA" & cRow).Formula = "=SUMIF(T$7:T$490,Y7,S$7:S$490)"
     Range("AB7:AB" & cRow).Formula = "=ROUND(AA7/$AC$5*$AC$4,0)"
     Range("AC7:AC" & cRow).Formula = "=SUMIF(T$7:T$390,Y7,R$7:R$390)"
     Range("AD7:AD" & cRow).Formula = "=IF(AE7=""TOOLING"",AC7+Z7*10,AC7+Z7*2)"
     
End Sub
test.rar (24.77 KB)

¤U¸ü¦¸¼Æ: 10

2019-10-1 20:17

jesscc

¦^´_ 16# Kubi
ÁÂÁÂK¤j¡A³o¼Ë§Ú´N¤£¥Î§ï¼g¥þ³¡ªºµ{¦¡¤F:'(

Kubi

¦^´_ 6# jesscc

¥u°w¹ï test.rar ¤ºªº¤¤ªº Transpose ºÃ°Ý¦^µª¦p¤U¡G
­Y¤£¥Î Transpose ¨Ó¸Ñ¡A¥i¥Î¤U¦C°j°é¤è¦¡¨Ó¼g¤J¡A¤£¹L¸ê®Æ¶q¦hªº¸Ü·|ªá¸û¦h®É¶¡¡C

­ì¦¡¡G
[AG7].Resize(d1.Count, 1) = Application.Transpose(d1.items)

§ï¬°¦p¤U¡G
s = d1.Items
For i = 0 To d1.Count - 1
    Cells(i + 7, 33).Value = s(i)
Next i

jesscc

¦^´_ 14# ­ã´£³¡ªL

ÁÂÁ­ã¤jªºÀ°¦£¡A§Ú¦A¦n¦n¬ã¨s¾Ç²ß¤@¤U¡C

­ã´£³¡ªL

¦^´_ 13# jesscc

Sub A_To_B()
Dim mRow&, Crr, Y As Range, YR, C%
Set d = CreateObject("scripting.dictionary")
mRow = Sheets("¤u§@ªí2").[B500].End(xlUp).Row + 1
For Each Y In Range([Y7], [Y300].End(3))
d(Y & "") = Array(Y.Offset(, -1), Y, Y.Offset(, 6), Y.Offset(, 8), "", Y, "PKG", Y.Offset(, -1), Y.Offset(, 7), "", Y.Offset(, 3) / Y.Offset(, -1), Y.Offset(, 3), Y.Offset(, 4), Y.Offset(, 5))
If C = 0 Then C = UBound(d(Y & "")) + 1
Next

N = 0
¦r¨åÀɪºitem¬O°}¦C, ¥²¶·³v¤@½Õ¥Î
ReDim Crr(1 To d.Count, 1 To C)
For Each k In d.keys
    N = N + 1
    YR = d(k & "")
    For j = 1 To C: Crr(N, j) = YR(j - 1): Next
Next
With Sheets("¤u§@ªí2")
     .Range("B" & mRow).Resize(N, C).Value = Crr 'range«e¤Ö¤@­Ó "."
     .Activate
End With
End Sub

============================

jesscc

­ã¤j¡A¯à§_¦AÀ°§Ú¬Ý¤@¤U¡A§Ú§ï¼g«á¤u§@ªí1ªº¸ê®Æ­nÂà¨ì¤u§@ªí2ªº¥N½X¡A¦]¬°¤ñ¸û¤Ö¥Î³o¼ËªºÂà¸ê®Æªk¡A©Ò¥H»yªk¤£¬O«ÜÀ´¡A°õ¦æ°_¨ÓÁöµM¨S°»¿ù¡A¦ý¬O¸ê®Æ¤]¨SÂন¡C
test2.rar (31.05 KB)

¤U¸ü¦¸¼Æ: 6

2019-10-3 16:28

­ã´£³¡ªL

¦^´_ 10# jesscc

¨º¬O T.cells(?, ?) ªº¥Îªk,
·í®æ T(1,1)
¥k¤@®æ T(1,2)
¥ª¤@®æ T(1,0)

ikboy

¸Õ¤@¤U³æ¦r¨å¤èªk

1. Sub zz()
   
2. Dim a, d As Object, c!, e!, b(9), ar, br, tr, kr, k, t, n&, kk, tt
   
3. If [T7] = "" Then Exit Sub
   
4. [x6].CurrentRegion.Offset(4).Clear
   
5. Set d = CreateObject("scripting.dictionary")
   
6. c = [ac4]
   
7. e = [ac5]
   
8. a = [n6].CurrentRegion
   
9. ar = Array(8, 7, 6, 5)
   
10. br = Array(0, 1, 3, 5)
    
11. For i = 2 To UBound(a)
    
12.     k = a(i, 7)
    
13.     If Len(a(i, 2)) Then
    
14.         kk = k & "|" & a(i, 2)
    
15.         If Not d.exists(kk) Then
    
16.             d(kk) = Array(a(i, 3), a(i, 4))
    
17.         Else
    
18.             t = d(kk)
    
19.             t(0) = t(0) + a(i, 3)
    
20.             d(kk) = t
    
21.         End If
    
22.     End If
    
23.     b(8) = Join(Array(a(i, 1), a(i, 3), a(i, 4)), " ")
    
24.     For j = 0 To UBound(br)
    
25.         b(br(j)) = a(i, ar(j))
    
26.     Next
    
27.     b(2) = 1
    
28.     If Not d.exists(k) Then
    
29.         d(k) = b
    
30.     Else
    
31.         t = d(k)
    
32.         n = 0
    
33.         t(2) = t(2) + 1
    
34.         For Each j In Array(3, 5)
    
35.             t(j) = t(j) + b(j)
    
36.             n = n + 1
    
37.         Next
    
38.         t(8) = t(8) & ", " & b(8)
    
39.         d(k) = t
    
40.     End If
    
41. Next
    
42. For i = 2 To UBound(a)
    
43.     If Len(a(i, 2)) Then
    
44.         k = a(i, 7)
    
45.         kk = k & "|" & a(i, 2)
    
46.         If d.exists(kk) Then
    
47.             t = d(k)
    
48.             tt = d(kk)
    
49.             t(9) = t(9) & ", " & Join(Array(a(i, 2), tt(0), tt(1)))
    
50.             d.Remove (kk)
    
51.             d(k) = t
    
52.         End If
    
53.     End If
    
54. Next
    
55. t = d.items
    
56. ReDim br(1 To d.Count, 1 To 10)
    
57. ar = Array("PUMP MOTOR", "TOOLING")
    
58. For i = 0 To UBound(t)
    
59.     k = t(i)
    
60.     For j = 0 To UBound(k)
    
61.         br(i + 1, j + 1) = k(j)
    
62.     Next
    
63.     br(i + 1, 5) = Round(br(i + 1, 4) / e * c, 0)
    
64.     n = IIf(InStr(br(i + 1, 10), "TOOLING"), 10, 2)
    
65.     br(i + 1, 7) = br(i + 1, 6) + br(i + 1, 3) * n
    
66.     br(i + 1, 10) = Mid(br(i + 1, 10), 3)
    
67.     For jj = 0 To UBound(ar)
    
68.         If InStr(br(i + 1, 10), ar(jj)) Then br(i + 1, 8) = ar(jj)
    
69.     Next
    
70.     If br(i + 1, 8) = "" Then br(i + 1, 8) = "MACHINE ACCESSORY"
    
71. Next
    
72. [x7].Resize(i, j) = br
    
73. [x7].Resize(i, j).Borders.Weight = 1
    
74. End Sub

½Æ»s¥N½X

jesscc

·PÁ­ã¤jªºÀ°¦£¡A¥Î±z¤¤­^¦X¨Öªº¤è¦¡½T¹ê¤S§Ö¤S¥¿½T¡A¤£¹L§Ú¦³­Ó°ÝÃD
    s1$ = T(, -5) & " " & T(, -3) & " " & T(, -2)
    s2$ = T(, -4) & " " & T(, 3) & " " & T(, -2)
T¬A¸¹¸Ìªº¼Æ­È¨ì©³¬O¥H­þ¤@Äæ°µ°ò·Ç±Àºâ¥X¨Óªº?

­ã´£³¡ªL

¦^´_ 6# jesscc

¥HÅܼƥN´À¤å¦r¦ê, ÁקK¦h¦¸¤Þ¥ÎÀx¦s®æ, ¥i´£¤É®Ä²v,
¦P®É, ­Y¶·§ó§ï, ¥u­n­×§ï¤@­Ó¦a¤è§Y¥i~~
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
For Each T In Range([T7], [T300].End(xlUp))
    s1$ = T(, -5) & " " & T(, -3) & " " & T(, -2)
    s2$ = T(, -4) & " " & T(, 3) & " " & T(, -2)
    If d(T & "") = "" Then
       d(T & "") = s1
       d1(T & "") = s2
    Else
       d(T & "") = d(T & "") & ", " & s1
       d1(T & "") = d1(T & "") & ", " & s2
    End If
Next
ReDim Arr(1 To d.Count, 0), Brr(1 To d.Count, 1 To 2)
For Each k In d.keys
    N = N + 1
    Arr(N, 0) = k
    Brr(N, 1) = d(k)
    Brr(N, 2) = d1(k)
Next
[Y7].Resize(N, 1) = Arr
[AF7].Resize(N, 2) = Brr

=======================================