在不固定範圍內找出相同資料

jesscc

如何在不固定範圍內(如圖01的 Z12:AK~，資料列數由Range(.[D12], .[D65536].End(xlUp)決定)
找出相同的廠商，然後把相同的廠商排列在一起，資料轉成像圖02這樣

圖02"成品"欄位的數值，由圖01的"QTY"欄x"DEMAND PCS"欄

下載 (44.36 KB)
01

2018-10-18 22:28

下載 (28.82 KB)
02

2018-10-18 22:28

ACC.rar (4.32 KB)

下載次數: 10

2018-10-18 22:29

hcm19522

A12:B23{=IFERROR(INDIRECT("工作表1!"&TEXT(RIGHT(SMALL(IF((MOD(COLUMN($AB12:$AK24),3)=1)*(工作表1!$AB$12:$AK$24>0),CODE(工作表1!$AB$12:$AK$24)/1%%+ROW(AB$12:AK$24)/1%+COLUMN($AB12:$AK24)-(COLUMN(A1)=2)*2),ROW(A1)),4),"!R0C00"),),"")

G12:G23{=IF(A12="","",SUM(IFERROR(工作表1!M$12:M$24*(工作表1!AB$12:AK$24=A12)*(工作表1!Z$12:AI$24=B12)*工作表1!AA$12:AJ$24,)))

I12:I23{=INDEX(工作表1!D:D,LARGE(IF((工作表1!AB$12:AK$24=A12)*(工作表1!Z$12:AI$24=B12),ROW(D$12:D$24)),1))&""

Kubi

回復 1# jesscc

請參考

1. Sub test()
   
2.     Dim arr
   
3.     Dim brr()
   
4.     arr = Range("D12", "AK" & [D65536].End(xlUp).Row)
   
5.     For i = 1 To UBound(arr)
   
6.         For j = 23 To 33 Step 3
   
7.             If arr(i, j) <> "" Then
   
8.                 n = n + 1
   
9.                 ReDim Preserve brr(1 To 9, 1 To n)
   
10.                 brr(1, n) = arr(i, j + 2)
    
11.                 brr(2, n) = arr(i, j)
    
12.                 brr(7, n) = arr(i, 10) * arr(i, j + 1)
    
13.                 brr(9, n) = arr(i, 1)
    
14.             End If
    
15.         Next j
    
16.     Next i
    
17.     With Sheets("工作表2")
    
18.         .Rows("12:65536").Delete
    
19.         .[A12].Resize(n, 9) = Application.Transpose(brr)
    
20.         .Select
    
21.     End With
    
22. End Sub

複製代碼

jesscc

回復 3# Kubi

跟需求目的稍有差異，相同的廠商沒有排列在一起。不過這部分用人工篩選也沒關係，謝謝大大。
另外有個小問題arr和brr()有什麼差別?

Kubi

回復 4# jesscc
Q1：相同的廠商沒有排列在一起
A1：只要在With Sheets("工作表2")內的.Select之前插入底下這行程式碼
.[A12].Resize(n, 9).Sort key1:=.[A12]

Q2：arr和brr()有什麼差別?
A2：arr：屬靜態陣列，用在可確認陣列大小的情況
brr()：屬動態陣列，用在無法確認陣列大小的情況

jesscc

謝謝K大的幫忙

Andy2483

謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列.迴圈與排序,學習方案如下,請各位前輩指教

Option Explicit
Sub TEST()
Dim Brr, Crr, i&, j%, N&
工作表2.UsedRange.Offset(11).ClearContents
Brr = Range([工作表1!IV11].End(xlToLeft)(2), [工作表1!D65536].End(3))
ReDim Crr(1 To 1000, 1 To 9)
For i = 1 To UBound(Brr)
   For j = 23 To UBound(Brr, 2) Step 3
      If Trim(Brr(i, j)) = "" Then GoTo i01 Else N = N + 1
      Crr(N, 1) = Brr(i, j + 2): Crr(N, 2) = Brr(i, j): Crr(N, 9) = Brr(i, 1)
      Crr(N, 7) = Val(Brr(i, j + 1)) * Val(Brr(i, 10))
   Next
i01: Next
If N = 0 Then Exit Sub
With 工作表2.[A12].Resize(N, 9)
   .Value = Crr
   .Sort KEY1:=.Item(1), Order1:=1, Header:=2
   Application.Goto .Cells
End With
End Sub