Dizi içine elaman ekleme

[bebar]

merhaba,

oluşturduğum bir diziye sonradan bir değer eklemek istiyorum.
ReDim Preserve ile sanırım oluyor ama sürekli hata aldım.

kodun sonuna doğru eklemek istediğim yeri belirrtim.
yardımcı olursanız çok memnun olurum.

teşekkürler.

Function Varmı1(aranan As Variant, dizi As Variant) As Boolean
'2.yöntem)Match, tam eşleşme sağlanıyor
On Error GoTo hata
    Varmı1 = Not IsError(WorksheetFunction.Match(aranan, dizi, 0))
Exit Function
hata:
    Varmı1 = False
End Function
Function Varmı2(aranan As Variant, dizi As Variant) As Boolean
'2.yöntem)Match, tam eşleşme sağlanıyor
On Error GoTo hata
    Varmı2 = Not IsError(WorksheetFunction.Match(aranan, dizi, 0))
Exit Function
hata:
    Varmı2 = False
End Function


Sub deneme()
Dim s1 As Worksheet
Dim s2 As Worksheet
Dim s3 As Worksheet
Dim s4 As Worksheet
Dim wf As WorksheetFunction

Dim a As Variant
Dim b As Variant
Dim rapor() As String
Dim rapor1() As String

Dim i As Integer
Dim ii As Integer
Dim k As Integer
Dim p As Integer
Dim p2 As Integer

Set s1 = Sheets("Rapor")
Set s2 = Sheets("depolar-2")
Set s3 = Sheets("var")
Set s4 = Sheets("veri")
Set wf = Application.WorksheetFunction
x = s1.Cells(Rows.Count, 1).End(xlUp).Row
x2 = s3.Cells(Rows.Count, 3).End(xlUp).Row

a = s2.Range("B4:B" & s2.Cells(Rows.Count, "B").End(3).Row).Value
b = s3.Range("c5:c" & s3.Cells(Rows.Count, "c").End(3).Row).Value


ReDim rapor(1 To UBound(a, 1))
For i = 1 To UBound(a, 1)
   rapor(i) = a(i, 1)
Next i


ReDim rapor1(1 To UBound(b, 1))
For ii = 1 To UBound(b, 1)
   rapor1(ii) = b(ii, 1)
Next ii



For i = 4 To x

  If s1.Cells(i, 19) = "TK" And s1.Cells(i, 26) > s1.Cells(i, 25) Then
     key1 = s1.Cells(i, 1)
        If Varmı1(key1, rapor) = True Then
        mt1 = wf.Match(s1.Cells(i, 1), s2.Range("B:B"), 0)
        mt2 = wf.Match(s1.Cells(i, 1), s2.Range("B:B"), 1)
        For k = mt1 To mt2
            If s2.Cells(k, 8) = "YENİ SEZON" Then
                k1 = s2.Cells(k, 3)
                k2 = s1.Cells(i, 11)
                key2 = k1 & "-" & k2

                If Varmı2(key2, rapor1) = False Then
                
                    If s2.Cells(k, 76) > 2 And s1.Cells(i, 26) > s1.Cells(i, 25) Then
                        For p = 1 To 30
                           If s2.Cells(k, p + 44) > 0 And s2.Cells(2, p + 44) = "" Then
                                y = s4.Cells(Rows.Count, 1).End(xlUp).Row
                                    For p2 = 1 To 9
                                        s4.Cells(y + 1, p2) = s2.Cells(k, p2 + 3)
                                    Next p2
                                        s4.Cells(y + 1, 10) = s2.Cells(3, p + 44)
                                        s4.Cells(y + 1, 11) = s1.Cells(i, 11)
                                        s4.Cells(y + 1, 12) = 1
                                        s4.Cells(y + 1, 13) = "YENİ SEZON"
                                        
                                        s2.Cells(k, p + 44) = s2.Cells(k, p + 44) - 1
                                        s1.Cells(i, 22) = s1.Cells(i, 22) + 1
                                        s1.Cells(i, 27) = s1.Cells(i, 27) + 1
                            ElseIf s2.Cells(k, p + 44) > 1 And s2.Cells(2, p + 44) = 1 Then
                                    y = s4.Cells(Rows.Count, 1).End(xlUp).Row
                                    For p2 = 1 To 9
                                        s4.Cells(y + 1, p2) = s2.Cells(k, p2 + 3)
                                    Next p2
                                        s4.Cells(y + 1, 10) = s2.Cells(3, p + 44)
                                        s4.Cells(y + 1, 11) = s1.Cells(i, 11)
                                        s4.Cells(y + 1, 12) = 2
                                        s4.Cells(y + 1, 13) = "YENİ SEZON"
                                        
                                        s2.Cells(k, p + 44) = s2.Cells(k, p + 44) - 2
                                        s1.Cells(i, 22) = s1.Cells(i, 22) + 2
                                        s1.Cells(i, 27) = s1.Cells(i, 27) + 2
                            End If
                        Next p
                            
                        
                        
''''''''''''''''''işte burada rapor1 bir dizisine "key2" değerini eklemek istiyorum.
                        ii = ii + 1
                        .Item (rapor1(ii)=  key2
                            
                            
                        
                    End If
                End If
            End If
        Next k
    End If
    End If
Next i
                                        

End Sub

 

[Korhan Ayhan]

Merhaba,

Kendinize uyarlarsınız.

Option Explicit

Sub Test()
    Dim X As Byte
    
    ReDim Liste(1 To 10)
    
    For X = 1 To 10
        Liste(X) = Cells(X, 1)
    Next

    ReDim Preserve Liste(1 To 11)
    Liste(X) = Cells(X, 1)
End Sub

 

[bebar]

hocam çok teşekkür ederim.
çok faydası oldu