Mevcut makroya şart ekleme

[hamza02]

Aşağıdaki kodlarda belirtilen kritere ek olarak Kayıt Sayfası "O" sütunundaki illerden Gaziantep 'e eşit olanları şartını nasıl ekleyebiliriz.
Verilerin başlangıç satırı 3. satır.



Option Explicit
Private Sub CommandButton1_Click()
Dim S1 As Worksheet, S2 As Worksheet, No As Long
Dim Son As Long, Veri As Variant, X As Long

Set S1 = Sheets("Makam")
Set S2 = Sheets("Kayıt")

S2.Range("A:A").ClearContents

Son = S2.Cells(S2.Rows.Count, "M").End(3).Row

If Son < 3 Then Exit Sub

Veri = S2.Range("M3:M" & Son).Value

ReDim Liste(1 To UBound(Veri), 1 To 1)

For X = LBound(Veri) To UBound(Veri)
If Veri(X, 1) >= S1.Range("F1") And Veri(X, 1) <= S1.Range("G1") Then
No = No + 1
Liste(X, 1) = No
End If
Next

S2.Range("A3").Resize(UBound(Liste), 1).Value = Liste

Set S1 = Nothing
Set S2 = Nothing

MsgBox "Veriler güncellenmiştir."

End Sub

 

[mustafa1205]

Option Explicit

Private Sub CommandButton1_Click()

Dim S1 As Worksheet, S2 As Worksheet
Dim Son As Long, X As Long, No As Long
Dim VeriTarih As Variant, VeriIl As Variant
Dim Liste() As Variant

Set S1 = Sheets("Makam")
Set S2 = Sheets("Kayıt")

S2.Range("A:A").ClearContents

Son = S2.Cells(S2.Rows.Count, "M").End(xlUp).Row
If Son < 3 Then Exit Sub

VeriTarih = S2.Range("M3:M" & Son).Value ' Tarih / kriter sütunu
VeriIl = S2.Range("O3:O" & Son).Value ' İl sütunu

ReDim Liste(1 To UBound(VeriTarih), 1 To 1)

For X = 1 To UBound(VeriTarih)

If VeriTarih(X, 1) >= S1.Range("F1") _
And VeriTarih(X, 1) <= S1.Range("G1") _
And Trim(VeriIl(X, 1)) = "Gaziantep" Then

No = No + 1
Liste(X, 1) = No

End If

Next X

S2.Range("A3").Resize(UBound(Liste), 1).Value = Liste

MsgBox "Veriler güncellenmiştir.", vbInformation

End Sub


Dener misiniz...

 

[Korhan Ayhan]

Tek dizi içine 2 sütundaki veriler yüklenirse daha pratik olacaktır.

 

[hamza02]

Sayın mustafa1205 hocam,
Elinize emeğinize sağlık evet çalışıyor. Çok teşekkür ederim.

 

[hamza02]

Sayın Korhan Ayhan hocam,
Ben makro yazmayı bilmiyorum, sizlerin yardımıyla yaptığım işleri kolaylaştıracak bir şeyler yapıyorum. Allah sizlerden razı olsun.

Bahsettiğiniz şekilde düzenleme yaparsanız kodları alırım. İlginize teşekkür ederim.

 

[mustafa1205]

Sayın mustafa1205 hocam,
Elinize emeğinize sağlık evet çalışıyor. Çok teşekkür ederim.

Kolay Gelsin İyi Çalışmalar Dilerim...

 

[Korhan Ayhan]

Dizi aralığını genişletip kullandım...

Veri = S2.Range("M3:O" & Son).Value

Option Explicit

Private Sub CommandButton1_Click()
    Dim S1 As Worksheet, S2 As Worksheet, No As Long
    Dim Son As Long, Veri As Variant, X As Long
    
    Set S1 = Sheets("Makam")
    Set S2 = Sheets("Kayıt")
    
    S2.Range("A:A").ClearContents
    
    Son = S2.Cells(S2.Rows.Count, "M").End(3).Row
    
    If Son < 3 Then Exit Sub
    
    Veri = S2.Range("M3:O" & Son).Value
    
    ReDim Liste(1 To UBound(Veri), 1 To 1)
    
    For X = LBound(Veri) To UBound(Veri)
        If Veri(X, 1) >= S1.Range("F1") And Veri(X, 1) <= S1.Range("G1") Then
            If Veri(X, 3) = "Gaziantep" Then
                No = No + 1
                Liste(X, 1) = No
            End If
        End If
    Next
    
    S2.Range("A3").Resize(UBound(Liste), 1).Value = Liste
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    MsgBox "Veriler güncellenmiştir."
End Sub