您好，我嘗試制作一個資料表，其中包含一系列原材料和供應商串列，例如此影像
資料源在另一張表
中 想法是收集供應商表中的每個唯一內容并將其提取到資料表表（第 1 行） ) 所以每個原材料類別都有一個由供應商串列組成的列。但問題是我不能讓供應商名稱填寫每列的最后一行空行，而且每列不能有多個供應商。有沒有人能告訴我我的代碼做錯了什么？
這是我的代碼
Sub uniquevalues()
Application.EnableEvents = False
Dim arr As New Collection, a
Dim arrS As New Collection, b
Dim rngRawCategory As Variant
Dim rngSupplier As Variant
Dim lrow As Long
rngSupplier = Range("C4:C1000") 'range in supplier sheet (Sheet3)
rngRawCategory = Range("D4:D1000") 'range in supplier sheet (Sheet3)
On Error Resume Next
For Each a In rngRawCategory
arr.Add a, a
Next
On Error Resume Next
For Each b In rngSupplier
arrS.Add b, b
Next
Sheet12.Range("B1:Z1000").ClearContents
For i = 1 To arr.Count
Sheet12.Cells(1, i 1) = arr(i)
For X = 1 To arrS.Count
If Sheet3.Cells(X 3, 4).Value = arr(i) Then
lrow = Sheet12.Cells(Rows.Count, i).End(xlUp).Row 1
Sheet12.Cells(lrow, i 1) = arrS(X)
End If
Next
Next
Application.EnableEvents = True
End Sub
uj5u.com熱心網友回復：
請嘗試下一個代碼。它使用字典為每個提取唯一的行材料名稱和相應的供應商：
Sub SuppliersPerUniqueMat()
Dim shMast As Worksheet, shSuppl As Worksheet, lastR As Long, arrMast, arrFin
Dim dict As Object, arrS, i As Long, j As Long, k As Long, maxCol As Long
Set shMast = Sheet3 ' sheet code Name!
Set shSuppl = Sheet12
lastR = shMast.Range("C" & shMast.rows.count).End(xlUp).row 'last row in the master sheet
arrMast = shMast.Range("C2:D" & lastR).value 'place the range in an array for faster iteration
Set dict = CreateObject("Scripting.Dictionary") 'create the necessary dictionary object
For i = 1 To UBound(arrMast) ' iterate between the array elements
dict(arrMast(i, 2)) = dict(arrMast(i, 2)) & "|" & arrMast(i, 1) 'place unique keys (materials) and their suppliers
If maxCol < UBound(Split(dict(arrMast(i, 2)), "|")) Then
maxCol = UBound(Split(dict(arrMast(i, 2)), "|")) 'determine the maximum suppliers number
End If
Next i
'redim the filan array to take maximum occurrences rows and dict number of items:
ReDim arrFin(1 To maxCol 1, 1 To dict.count): k = 1
For i = 0 To dict.count - 1 'iterate between the dictionary keys/items:
arrFin(k, i 1) = dict.Keys()(i): k = k 1 'place the dictionary key in the first row
arrS = Split(dict.items()(i), "|") 'split the item to extract suppliers in an array (0 is empty)
For j = 1 To UBound(arrS) 'iterate between the array elements
arrFin(k, i 1) = arrS(j): k = k 1 'place the suppliers of a specific key
Next j
k = 1 'reinitialize k for the next material
Next i
'drop the final array content at once:
shSuppl.Range("B1").Resize(UBound(arrFin), UBound(arrFin, 2)).value = arrFin
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/yidong/372753.html