Veri bulma

[mamita]

Selamlar,

Elimde 20 satır ve 20 sütunluk rakamların bulunduğu data seti var Amacım makro ile 100<x<110 arasındaki değerleri bulup bu değerleri listeye atmak Yardımcı olabilir misiniz

 

[Necdet]

Merhaba,

Bulunan değer 100'den büyük 110'dan küçük mü? bu değerlere 100 ve 110 dahil mi?

Sadece diziye almaktan mı söz ediyorsunuz?

 

[mamita]

Evet üstadım, kücük ve büyük esit olacaktır Find fonksiyonunu kullanmam gerekecek sanırım

 

[ÖmerFaruk]

Sub Aradakiler()
Dim Alan As Range, deger As Range, i As Integer
'A1:T20 aralığındaki sayısal değerleri
'dediğiniz şartlarda W sütununa 2.satırdan itibaren listeler

    Range("W2:W" & Rows.Count).ClearContents
    Set Alan = Range("A1:T20")
    For Each deger In Alan
        If deger > 100 And deger < 110 Then
            i = i + 1
            Range("W1").Offset(i, 0) = deger
        End If
    Next deger
End Sub

 

[mamita]

Sub Aradakiler()
Dim Alan As Range, deger As Range, i As Integer
'A1:T20 aralığındaki sayısal değerleri
'dediğiniz şartlarda W sütununa 2.satırdan itibaren listeler

    Range("W2:W" & Rows.Count).ClearContents
    Set Alan = Range("A1:T20")
    For Each deger In Alan
        If deger > 100 And deger < 110 Then
            i = i + 1
            Range("W1").Offset(i, 0) = deger
        End If
    Next deger
End Sub

Saygıdeğer hocam, birazdan deneyecegim Yazdıgınız koddan anladığım kadarıyla W sütununu boş dizi gibi algoritmasını oluşturup indisleri kullanarak dizi verisini bu sütüna attınız

 

[nunikmakarios]

buna bakar mısınız

 

[Necdet]

Merhaba,

Bu kodlar da benden olsun.

Önce seçimi yapıp sonra kodlar çalıştırılır, Çıkan değerleri N sütunundan itibaren listelenir, siz kodları kendinize göre uyarlayınız.

Sub Diziye_Al()

    Dim d() As Variant, _
        Hcr As Range, _
        i   As Integer
    
    If Selection.Count = 1 Then Exit Sub
    
    For Each Hcr In Selection
    
        If Hcr.Value >= 100 And Hcr.Value <= 110 Then
            i = i + 1
            ReDim Preserve d(1 To i)
            d(i) = Hcr.Value
        End If
        
    Next Hcr
    
    If Not i = 0 Then
        Range("N1").Resize(UBound(d), 1) = Application.WorksheetFunction.Transpose(d)
        MsgBox UBound(d) & " Kadar Veri Diziye Alınmıştır...."
    Else
        MsgBox "Aranan Değerleri Bulamadım....."
    End If
    
End Sub

 

[mamita]

Merhaba,

Bu kodlar da benden olsun.

Önce seçimi yapıp sonra kodlar çalıştırılır, Çıkan değerleri N sütunundan itibaren listelenir, siz kodları kendinize göre uyarlayınız.

Sub Diziye_Al()

    Dim d() As Variant, _
        Hcr As Range, _
        i   As Integer
   
    If Selection.Count = 1 Then Exit Sub
   
    For Each Hcr In Selection
   
        If Hcr.Value >= 100 And Hcr.Value <= 110 Then
            i = i + 1
            ReDim Preserve d(1 To i)
            d(i) = Hcr.Value
        End If
       
    Next Hcr
   
    If Not i = 0 Then
        Range("N1").Resize(UBound(d), 1) = Application.WorksheetFunction.Transpose(d)
        MsgBox UBound(d) & " Kadar Veri Diziye Alınmıştır...."
    Else
        MsgBox "Aranan Değerleri Bulamadım....."
    End If
   
End Sub

Üstadım elinize saglık az sonra deneyeceğim

 

[mamita]

Saygıdeğer hocalarım,
@Necdet
@ÖmerFaruk
Her iki kod da mis gibi çalışıyor Emeğinize sağlık
Makro syntaxına ve dizi yapısına biraz daha aşina olmam gerekiyor sanırım

 

[mamita]

Hocalarım, yaptıgımız işlemde listedeki değerlerin bulunduğu sütunun yanına değerlerin ilk sutünundaki veriyi yanındaki sütuna liste olarak eklemeye çalıştım Fakat bir türlü sonuç alamadım

İlk kod icin

Private Sub CommandButton1_Click()
_
Dim d() As Variant, _
k() As Variant, _
Hcr As Range, _
i As Integer, _
j As Integer

If Selection.Count = 1 Then Exit Sub

For Each Hcr In Selection

If Hcr.Value >= 100 And Hcr.Value <= 110 Then
i = i + 1
j = j + 1
ReDim Preserve d(1 To i)
ReDim Preserve k(1 To j)
d(i) = Hcr.Value
k(j) = Cells(ActiveCell.Row, 1)
End If

Next Hcr

If Not i = 0 And Not j = 0 Then
Range("U1").Resize(UBound(d), 1) = Application.WorksheetFunction.Transpose(d)
MsgBox UBound(d) & " Kadar Veri Diziye Alınmıştır...."
Range("V1").Resize(UBound(k), 1) = Application.WorksheetFunction.Transpose(d)
MsgBox UBound(k) & " Kadar Veri Diziye Alınmıştır...."
Else
MsgBox "Aranan Değerleri Bulamadım....."
End If

End Sub

İkinci kod icin


Private Sub CommandButton2_Click()
Dim Alan As Range, deger As Range, i As Integer

Range("W2:W" & Rows.Count).ClearContents
Set Alan = Range("C3:R14")
For Each deger In Alan
If deger > 100 And deger < 110 Then
i = i + 1
Range("U3").Offset(i, 0) = Cells(ActiveCell.Row, 1)
Range("T3").Offset(i, 0) = deger


End If
Next deger

 

[mamita]

Hocalarım address fonksiyonunu kullanarak hallettim
Teşekkürler