³£¼û×ÖµäÓ÷¨¼¯½õ¼°´úÂëÏê½â£¨È«£© - À¶ÇÅÐþ˪ - ͼÎÄ

ʵÀý12 ¸´ÔÓ±¨±í»ã×Ü

ͼ ʵÀý11-2ʾÀý

ʵÀý12 ¸´ÔÓ±¨±í»ã×Ü

Ò»¡¢ÎÊÌâµÄÌá³ö £º

ÓÐÒ»ÈÕ±¨±í£¬ÀïÃæÓÐÉú²úÐͺš¢Éú²úÊýÁ¿¡¢·µÐÞÔ­Òò¡¢·µÐÞÊýÁ¿¡¢±¨·ÏÔ­Òò¡¢±¨·ÏÊýÁ¿£¬ÒªÇó±àдһ¶Î´úÂ룬°´Í¬ÐͺŲúÆ·»ã×ÜÉú²úÊýÁ¿£»µÃµ½Í¬ÐͺŲúÆ·Ïàͬ·µÐÞÔ­ÒòµÄΨһֵ£»°´Í¬ÐͺŲúÆ·Ïàͬ·µÐÞÔ­Òò»ã×Ü·µÐÞÊýÁ¿£» µÃµ½Í¬ÐͺŲúÆ·Ïàͬ±¨·ÏÔ­ÒòµÄΨһֵ£»Í¬ÐͺŲúÆ·Ïàͬ±¨·ÏÔ­Òò»ã×ܱ¨·ÏÊýÁ¿£¬²¢ÇҺϲ¢ÏàͬÄÚÈݵĵ¥Ôª¸ñ¡£

´úÂëÖ´ÐÐǰÈçͼʵÀý12-1Ëùʾ¡£

45

³£¼û×ÖµäÓ÷¨¼¯½õ¼°´úÂëÏê½â

ͼ ʵÀý12-1ʾÀý

¶þ¡¢´úÂ룺 Sub bbhz()

Dim i&, Myr&, x(1 To 3), Arr, n%, aa, j&, Arr1(), r%, Arr2(), r2%, r3%, Arr3() Dim d(1 To 3) As New dictionary, k(1 To 3), t(1 To 3), js, ks, ii%, jj&, ks1, js1 Application.ScreenUpdating = False Myr = Sheet1.[a65536].End(xlUp).Row Arr = Sheet1.Range(\& Myr) For i = 1 To UBound(Arr) x(1) = Arr(i, 2)

d(1)(x(1)) = d(1)(x(1)) + Arr(i, 3) x(2) = Arr(i, 2) & \& Arr(i, 4) d(2)(x(2)) = d(2)(x(2)) + Arr(i, 5)

x(3) = Arr(i, 2) & \& Arr(i, 4) & \& Arr(i, 6) d(3)(x(3)) = d(3)(x(3)) + Arr(i, 7) Next

For i = 1 To 3

46

ʵÀý12 ¸´ÔÓ±¨±í»ã×Ü

k(i) = d(i).Keys t(i) = d(i).Items Next

Sheet4.Activate [a3:k1000].ClearContents [a3:k1000].UnMerge

[a3:k1000].Borders.LineStyle = xlNone

[i3].Resize(d(3).Count, 1) = Application.Transpose(t(3)) n = 2

For i = 0 To UBound(k(3)) aa = Split(k(3)(i), \ n = n + 1 Cells(n, 2) = aa(0) Cells(n, 4) = aa(1) Cells(n, 8) = aa(2) Next

For i = 3 To n

For j = 0 To UBound(k(1)) If Cells(i, 2) = k(1)(j) Then Cells(i, 3) = t(1)(j)

Cells(i, 10) = Cells(i, 9) / Cells(i, 3) Cells(i, 11) = Cells(i, 10): Exit For End If Next

For j = 0 To UBound(k(2))

If Cells(i, 2) & \& Cells(i, 4) = k(2)(j) Then Cells(i, 5) = t(2)(j)

Cells(i, 6) = Cells(i, 5) / Cells(i, 3) Cells(i, 7) = Cells(i, 6): Exit For End If Next Next

47

³£¼û×ÖµäÓ÷¨¼¯½õ¼°´úÂëÏê½â

Range(\& n).Sort Key1:=Range(\Order1:=xlAscending, Key2:=Range(\_

, Order2:=xlAscending, Key3:=Range(\Order3:=xlAscending, Header:= _ xlGuess For i = 3 To n

If Cells(i, 2) <> Cells(i - 1, 2) Then r = r + 1

ReDim Preserve Arr1(1 To r) Arr1(r) = i End If Next

Application.DisplayAlerts = False For j = 1 To r r3 = 0: r2 = 0 If j <> r Then

js = Arr1(j + 1) - 1 Else js = n End If ks = Arr1(j)

If js - ks + 1 > 1 Then

Cells(ks, 1).Resize(js - ks + 1, 1).Merge Cells(ks, 2).Resize(js - ks + 1, 1).Merge Cells(ks, 3).Resize(js - ks + 1, 1).Merge End If Cells(ks, 1) = j For ii = ks To js If ii = ks Then r2 = r2 + 1

ReDim Preserve Arr2(1 To r2) Arr2(r2) = ii

ElseIf Cells(ii, 4) <> Cells(ii - 1, 4) Then

48

ÁªÏµ¿Í·þ£º779662525#qq.com(#Ìæ»»Îª@)