Matrix omzetten naar tabel

Status
Niet open voor verdere reacties.
Dé logica.
Code: 
Sub hsv()
Dim sn, sq, i As Long, ii As Long, j As Long, n As Long
sn = Sheets("requirement").UsedRange
sq = Sheets("BoM").Cells(1).CurrentRegion
ReDim arr(4, 0)
For i = 2 To UBound(sn)
 For j = 2 To UBound(sn, 2)
   If sn(i, j) <> "" Then
    For ii = 1 To UBound(sq)
     If sn(1, j) = sq(ii, 1) Then
         arr(0, n) = sn(i, 1)
         arr(1, n) = sn(i, j)
         arr(2, n) = sq(ii, 1)
         arr(3, n) = sq(ii, 2)
         arr(4, n) = sq(ii, 3)
         n = n + 1
        ReDim Preserve arr(4, n)
      End If
    Next ii
    End If
   Next j
  Next i
Sheets("total").Cells(2, 10).Resize(n, 5) = Application.Transpose(arr)
End Sub
 

Bijlagen

  • BillOfMaterialToPickList.xlsb
    17,1 KB · Weergaven: 27
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan