İki Array birleştirme

[yusuf1284]

Public Function arrbirlestir2d(IlkArray As Variant, IkinciArray As Variant) As Variant
    Dim i As Long
    Dim j As Long
    Dim arrbirlestir As Variant

    If IsEmpty(IlkArray) And IsEmpty(IkinciArray) Then
        arrbirlestir2d = Array()
        Exit Function
    End If
  
    If IsEmpty(IlkArray) Then
        arrbirlestir2d = IkinciArray
        Exit Function
    End If
  
    If IsEmpty(IkinciArray) Then
        arrbirlestir2d = IlkArray
        Exit Function
    End If
  

    ReDim arrbirlestir(0 To UBound(IlkArray, 1), 0 To UBound(IlkArray, 2) + UBound(IkinciArray, 2) + 1)
  
    For j = LBound(IlkArray, 2) To UBound(IlkArray, 2)
        For i = LBound(IlkArray, 1) To UBound(IlkArray, 1)
            arrbirlestir(i, j) = IlkArray(i, j)
        Next i
    Next j
  
    For j = LBound(IkinciArray, 2) To UBound(IkinciArray, 2)
        For i = LBound(IkinciArray, 1) To UBound(IkinciArray, 1)
            arrbirlestir(i, j + UBound(IlkArray, 2) + 1) = IkinciArray(i, j)
        Next i
    Next j
  
    arrbirlestir2d = arrbirlestir
End Function

Değerli hocaalarım iki array birleştirdiğim bir kod mevcut benim yapmak istediğim şu stok numarası aynı ve seri numarası olmayan yani (-) olan değerleri (Miktarını ) birleştirilmiş bir array oluşturmak

 

[yusuf1284]

Şu şekilde bir çözüm buldum örnek olması için ekliyorum vakit ayırıp bakanlara teşekkür ederim.

Public Function arrbirlestir2d(ilkDizi As Variant, ikinciDizi As Variant) As Variant
    Dim i As Long, j As Long
    Dim bulundu As Boolean
    Dim birlesikKoleksiyon As New Collection
    Dim sonucDizisi() As Variant
    Dim anahtar As String

    If IsEmpty(ilkDizi) And IsEmpty(ikinciDizi) Then
        arrbirlestir2d = Array()
        Exit Function
    End If
    
    If IsEmpty(ilkDizi) Then
        arrbirlestir2d = ikinciDizi
        Exit Function
    End If
    
    If IsEmpty(ikinciDizi) Then
        arrbirlestir2d = ilkDizi
        Exit Function
    End If

    For j = LBound(ilkDizi, 2) To UBound(ilkDizi, 2)
        anahtar = ilkDizi(0, j) & "|" & ilkDizi(2, j)
        On Error Resume Next
        birlesikKoleksiyon.Add Array(ilkDizi(0, j), ilkDizi(1, j), ilkDizi(2, j), ilkDizi(3, j)), anahtar
        On Error GoTo 0
    Next j

    For j = LBound(ikinciDizi, 2) To UBound(ikinciDizi, 2)
        anahtar = ikinciDizi(0, j) & "|" & ikinciDizi(2, j)
        On Error Resume Next
        birlesikKoleksiyon.Add Array(ikinciDizi(0, j), ikinciDizi(1, j), ikinciDizi(2, j), ikinciDizi(3, j)), anahtar
        If Err.Number = 457 Then
            bulundu = True
            On Error GoTo 0
            Dim mevcutDeger() As Variant
            mevcutDeger = birlesikKoleksiyon(anahtar)
            If mevcutDeger(2) = "-" And ikinciDizi(2, j) = "-" Then
                mevcutDeger(3) = mevcutDeger(3) + 1
                birlesikKoleksiyon.Remove anahtar
                birlesikKoleksiyon.Add mevcutDeger, anahtar
            End If
        End If
        On Error GoTo 0
    Next j
    
    ReDim sonucDizisi(0 To 3, 0 To birlesikKoleksiyon.Count - 1)
    For i = 1 To birlesikKoleksiyon.Count
        Dim geciciDizi() As Variant
        geciciDizi = birlesikKoleksiyon(i)
        For j = LBound(geciciDizi) To UBound(geciciDizi)
            sonucDizisi(j, i - 1) = geciciDizi(j)
        Next j
    Next i
    
    arrbirlestir2d = sonucDizisi
End Function