Блог

Здравствуйте, я попытался сделать данные таблицы, которые состоят широкий спектр сырья со списком поставщиков, как это изображение источника данных в другой лист идея в том, чтобы собрать каждый уникальный контент в лист с поставщиком и распакуйте его на стол лист данных (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  

Пожалуйста, попробуйте следующий код. Он использует словарь для извлечения уникального названия материалов строки и соответствующего поставщика для каждого:

 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" amp; shMast.rows.count).End(xlUp).row 'last row in the master sheet  arrMast = shMast.Range("C2:D" amp; 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)) amp; "|" amp; arrMast(i, 1) 'place unique keys (materials) and their suppliers  If maxCol lt; 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