Kullanılcak ve Kullanılan dizisini karşılaştırarak kalan dizisini elde etme?

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
ArrKUllanılacak dizimiz ve arrKullanılan dizilemiz var. Ancak Arrkullanılan dizisinde arrKullanılacak dizisinin elemanı olmaynlarda var. bu iki diziyi karşılaştırıp Arrkalan dizisini elde etmek mümkün müdür?
Eğer olmuyorsa ArrKUllanılan2 dizisinde sadece ArrKulanılacak dizisinin elemanları var, bu iki diziyi karşılaştırıp arr kullanılanı elde etmek mümkünmüdür?

Kod:
arrKullanılacak = Array(1, 7, 13, 19, 25, 31, 37, 43, 49, 55, 61, 67)
arrKullanılan = Array(1, 49, 73, 55, 115, 31, 97, 1, 139, 43)
[COLOR=Green]arrKullanılan2 = Array(1, 49, 55, 31, 1, 43)[/COLOR]

[FONT=Courier New][COLOR=Red]ArrKalan=Array(7, 13, 19, 25, 31, 37, 43, 49, 55, 61, 67)[/COLOR][/FONT]
 
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Çİftboyutlu dizi ile uğraşıınca uyarlamamışım sorduğum soruyu mükerrer sormuşum.

Kod:
Sub Testdizi22()
Dim Csf As Excel.Worksheet:     Set Csf = Worksheets("Hsr")
'Dim rngHepsi As Range
Dim aHepsi(), aKars()
Dim aHps(), aKrs()
With Csf
  aHepsi = .Range(.Cells(3, 1), .Cells(14, 1))
  aKars = .Range(.Cells(3, 6), .Cells(3, 14))
   
'aHepsi çift boyutlu dizisini tek boyuta düşür.
  i = 0: ii = 0
  For i = LBound(aHepsi, 1) To UBound(aHepsi, 1)
    ii = ii + 1
    ReDim Preserve aHps(1 To ii)
    aHps(ii) = aHepsi(i, 1)
  Next i
  Erase aHepsi
'aKars çift boyutlu dizisini tek boyuta düşür.
   i = 0: ii = 0
   For i = LBound(aKars, 2) To UBound(aKars, 2)
    ii = ii + 1
    ReDim Preserve aKrs(1 To ii)
    aKrs(ii) = aKars(1, i)
  Next i
  Erase aKars
  
'Kalan Elamanları Öğren...
   aAdanKalan = fncDizideOlmayan(aHps, aKrs)
   For i = LBound(aAdanKalan) To UBound(aAdanKalan)
    msj = msj & aAdanKalan(i) & vbNewLine
   Next i
   MsgBox msj
End With


End Sub


Function fncDizideOlmayan(aHepsi, aKars)
'Ferhat Pazarçevirdi'nin kodlarından uyarlamadır.
  Dim bBoo As Boolean
  Dim aBos()
  Dim i%, j%, x%
  fncDizideOlmayan = Array(Empty)
  If IsArray(aKars) And IsArray(aHepsi) Then
    If UBound(aKars) > 0 And UBound(aHepsi) > 0 Then
      For i = LBound(aHepsi) To UBound(aHepsi)
      
        For j = LBound(aKars) To UBound(aKars)
          If aHepsi(i) = aKars(j) Then
            bBoo = True
            Exit For
          End If
        Next j
                
        If Not bBoo Then
          x = x + 1
          ReDim Preserve aBos(1 To x)
          aBos(x) = aHepsi(i)
        End If
                
        bBoo = False
      Next i
    End If
  End If
fncDizideOlmayan = aBos
End Function
 
Üst