[µ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

­ã´£³¡ªL

°Ñ¦Ò:
http://forum.twbts.com/thread-22063-1-2.html

À³¸Ó¬O transpose ¶W­­°ÝÃD

jesscc

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

­ã¤j¡A±z¦n¡A³o­Ó°ÝÃD§Ú¤]·Q¹L¡A¦ý¬O¦P¼Ëªº»yªk¡A¤¤¤åªº¸ê®Æªø«×§óªø¡A¦X¨Ö«o¨S°ÝÃD¡C

­ã´£³¡ªL

¦^´_ 3# jesscc


³o¤å¦rªø«×¦p¦óÅýtranspose²£¥Í¿ù»~, §Ú¤]¤£²M·¡, ¾¨¶q¤£¥Î~~

'­^¤å«~¶µ¦X¨Ö
Dim Brr, N&, U&, TS$
Set d1 = CreateObject("Scripting.Dictionary")
ReDim Brr(1 To [T300].End(xlUp).Row, 0) '©w¸q¤@­Ó°}¦C[®e¯Ç¾¹]
For Each T In Range([T7], [T300].End(xlUp))
If T(1, 3) = "" Or T(1, -4) = "" Then GoTo AA 'T®æ©Î­^¤å«~¶µ¬°ªÅ--²¤¹L
   TS = T(1, -4) & " " & T(1, 3) & " " & T(1, -2) '¸Ó¦æ¦ê±µ¤å¦r
   U = d1(T & "") '¨ú±o¦r¨åÀɬÛÀ³ªº[§Ç¸¹]
   If U > 0 Then Brr(U, 0) = Brr(U, 0) & "," & TS:   GoTo AA '¦pªG§Ç¸¹¤j¤_0, ¶i¦æ²Ä2µ§¥H«áªº¦ê±µ
   N = N + 1:   d1(T & "") = N:   Brr(N, 0) = TS '¦pªG§Ç¸¹¬°0, §Ç¸¹»¼¼W1¦s¤J¦r¨åÀÉ, ¶ñ¤J²Ä¤@­Ó¤å¦r¦ê
AA: Next
[AG7].Resize(N, 1) = Brr


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

Kubi

¦^´_ 3# jesscc

2010ª©ªºExcel Application.Transpose ¦³¨â­Ó¸nªù
1.¸m´«ªº¤¸¯À¤¤­Y¦³¶W¥X256¦r¤¸·|²£¥Í¿ù»~¡C
2.¸m´«ªº¦C¼Æ­Y¶W¥X65536¦C·|²£¥Í¿ù»~¡C

°õ¦æ§Aªºµ{¦¡½X«á©Ò±o¦r¤¸¼Æ¸ê®Æ¦p¤U¡G
áMÀY¸¹34¡i¤¤¤å«~¶µ¦X¨Ö¡j¬°21
áMÀY¸¹34¡i­^¤å«~¶µ¦X¨Ö¡j¬°16

áMÀY¸¹35¡i¤¤¤å«~¶µ¦X¨Ö¡j¬°161
áMÀY¸¹35¡i­^¤å«~¶µ¦X¨Ö¡j¬°138

áMÀY¸¹36¡i¤¤¤å«~¶µ¦X¨Ö¡j¬°211
áMÀY¸¹36¡i­^¤å«~¶µ¦X¨Ö¡j¬°306

áMÀY¸¹37¡i¤¤¤å«~¶µ¦X¨Ö¡j¬°176
áMÀY¸¹37¡i­^¤å«~¶µ¦X¨Ö¡j¬°170

áMÀY¸¹38¡i¤¤¤å«~¶µ¦X¨Ö¡j¬°8
áMÀY¸¹38¡i­^¤å«~¶µ¦X¨Ö¡j¬°3

¸ê®Æ¿ù»~¥X²{¦báMÀY¸¹36¡i­^¤å«~¶µ¦X¨Ö¡j¬°306¡A¤w¶W¥X256ªº¤W­­¡A¦Ó©Ò¦³¤¤¤å«~¶µ§¡¦X¥G³W«h¡A¦]¦¹¤£·|¥X¿ù¡C

jesscc

¦^´_ 5# Kubi
·PÁÂK¤j¡A§Úª¦¤F«Ü¦h¤å¡A¤]½T»{¤F³o¤@ÂI¡C¦ý¬O²{¦b¦³­ÓÀY¯kªº¦a¤è¡A¦]¬°§Úªº¥N½XùØÁÙ¦³¨ä¥L´X­Ó¦a¤è³£¥Î¤FTranspose³o­ÓÂà¸m¨ç¼Æ¡A±N¨Ó¥i¯à·|ºÆ¨g°»¿ù¡A¸Ó¦p¦ó§ï¼g©O?­ã¤j¨â­Ó°}¦C¨Ã¥Îªº¼gªk¡A¥®¨à¶éµ{«×ªº§Ú¤£¤Ó·|¥Î?ªþ¤W§ó·sªºÀɮסAùØ­±¦³§Ú­ì©lªº¼gªk¡C
test1.rar (31.11 KB)

¤U¸ü¦¸¼Æ: 4

2019-10-2 23:02

­ã´£³¡ªL

¦^´_ 6# jesscc

'¤¤¤å«~¶µ¦X¨Ö
Set d = CreateObject("Scripting.Dictionary")
For Each T In Range([T7], [T300].End(xlUp))
   If d(T.Value) = "" Then
      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
ReDim Arr(1 To d.Count, 0), Brr(1 To d.Count, 0)
For Each k In d.keys
    N = N + 1: Arr(N, 0) = k: Brr(N, 0) = d(k)
Next
[Y7].Resize(N, 1) = Arr
[AF7].Resize(N, 1) = Brr

'=========================================
'­^¤å«~¶µ¦X¨Ö
Set d1 = CreateObject("Scripting.Dictionary")
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
N = 0: ReDim Arr(1 To d1.Count, 0)
For Each k In d1.items
    N = N + 1: Arr(N, 0) = k
Next
[AG7].Resize(N, 1) = Arr


±N¦r¨åÀɦA°µ¤@¦¸«á¸m³B²z, ¯Ç¤J°}¦C§Y¥i~~

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

­ã´£³¡ªL

¦^´_ 6# jesscc

¨âºØ¦X¨Ö¤@¦¸°j°é§¹¦¨:
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
For Each T In Range([T7], [T300].End(xlUp))
   If d(T & "") = "" Then
      d(T & "") = T(, -5) & " " & T(, -3) & " " & T(, -2)
      d1(T & "") = T(, -4) & " " & T(, 3) & " " & T(, -2)
   Else
      d(T & "") = d(T & "") & ", " & T(, -5) & " " & T(, -3) & " " & T(, -2)
      d1(T & "") = d1(T & "") & ", " & T(, -4) & " " & T(, 3) & " " & T(, -2)
    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

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

­ã´£³¡ª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

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

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¨Óªº?