• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Mevcut makroya şart ekleme

H

hamza02

Katılım
24 Mart 2021
Mesajlar
40
Excel Vers. ve Dili
Türkçe
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
 
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...
 
Tek dizi içine 2 sütundaki veriler yüklenirse daha pratik olacaktır.
 
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.
 
Dizi aralığını genişletip kullandım...

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

C++: 
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
 
Sayın Korhan Ayhan hocam,
Elinize emeğinize sağlık, çok güzel olmuş.
Allah razı olsun. Allah'a emanet olun. Hayırlı Ramazanlar.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst