Kritere göre verileri listelemek

[aybekcan]

Aşağıda ki macronun 1.sayfada ki bir satırı tarayıp kıstaslara uyan hücrenin değerlerini yine 2. sayfadaki bir satır üzerinde sırasıyla yazması gerekiyor.örn:
ASDF VRB02KT 5000 BR FEW040 BECMG 0714/0717 CAVOK BECMG 0805/0808 16012KT 1500 BR SCT040 BKN100 PROB40 TEMPO 0809/0812 16015G25KT - 0800 TSRA BR FEW027CB BKN035=(bunun tamamını bir satır olarak farz edelim.)
Burada bütün satırı tarayıp, 2. sayfada ki 2. satıra; sırayla b1 hücresine 5000,b2 hücresine 1500 ve b3 hücresine de 800 yazması gerekiyordu.kod hata vermiyor,çalışırmış gibi görünüyor ama hiç bir şeyde yapmıyor.Nedenini anlayamadım.üstatlardan yardım rica ediyorum.

Sub olay()
Dim i As Integer, s1 As Worksheet, s2 As Worksheet, hcr As Range, aralık
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
For b = 3 To 30
For c = 1 To 30
Set hcr = s1.Cells(2, b)
For i = 0 To UBound(Split(hcr, " "))
aralık = Split(hcr, " ")(i)
ic = s2.Cells(c, b)
If IsNumeric(aralık) = True Then
If aralık >= 9999 Then
ic = aralık
ElseIf aralık < 9999 And aralık >= 8000 Then
ic = aralık
ElseIf aralık < 8000 And aralık >= 5000 Then
ic = aralık
ElseIf aralık < 5000 And aralık >= 3700 Then
ic = aralık
ElseIf aralık < 3700 And aralık >= 1600 Then
ic = aralık
ElseIf aralık < 1600 And aralık >= 800 Then
ic = aralık
ElseIf aralık < 800 And aralık >= 0 Then
ic = aralık
Exit For: Exit For: Exit For
End If: End If
Next i
Next c
Next b
s2.Activate
End Sub

 

[Necdet]

Merhaba,

Örnek dosyanızı (bir kaç veri içeren) www.dosya.tc gibi paylaşım sitelerinden birine ekleyin, dosyanızı inceleyecek olan arkadaşlara yardımcı olacaktır.

Dediğinizle kodlar pek uyuşmuyor gibi geldi bana. Bunun için de dosya şart.

 

[aybekcan]

ok. hocam hemen yüklüyorum..

 

[aybekcan]

excel dosyasını linke yükledim. http://s7.dosya.tc/server4/ba8gmk/aaa.xlsx.html
üste yazdığım makroyla aslında pey der pey bu belgede yapılan şeyi başarmaya çalışıyordum.
yani üstteki makrodan sonra başka şeyleri ekleyerek bu sayfadaki yapılan işi başarmaktı amacım.
bu konuda yardım rica ediyorum.

 

[Korhan Ayhan]

Necdet beye katılıyorum. Bulmaca gibi soru sormuşsunuz.

Verilerim bunlar şu kriterlere göre şu şekilde bir rapor oluşturmak istiyorum diye sorsanız durum daha çabuk çözüme ulaşacak.

Anladığım kadarıyla kodu revize ettim. Deneyin. Hatalı kurguladığım yer varsa revize ederiz.

Option Explicit

Sub Rapor()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Son As Long, Veri As Range
    Dim Bul As Range, X As Byte
    Dim Satir As Long, Sutun As Byte
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    
    Son = S1.Cells(Rows.Count, 1).End(3).Row
    S2.Range("C3:AZ" & Rows.Count).ClearContents
    
    For Each Veri In S1.Range("A1:A" & Son)
        Sutun = 3
        Set Bul = S2.Range("B:B").Find(Veri.Value, , , xlWhole)
        If Not Bul Is Nothing Then
            For X = 1 To 30
                If Not IsError(S1.Cells(Veri.Row, X)) Then
                    If InStr(1, S1.Cells(Veri.Row, X), "/") > 0 Then
                        S2.Cells(Bul.Row, Sutun) = S1.Cells(Veri.Row, X)
                        Sutun = Sutun + 1
                    End If
                    If UCase(S1.Cells(Veri.Row, X)) = "CAVOK" Then
                        S2.Cells(Bul.Row, Sutun) = 9999
                        Sutun = Sutun + 1
                    End If
                    If IsNumeric(S1.Cells(Veri.Row, X)) Then
                        S2.Cells(Bul.Row, Sutun) = S1.Cells(Veri.Row, X)
                        Sutun = Sutun + 1
                    End If
                End If
            Next
        End If
    Next
    
    S2.Activate
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[aybekcan]

hocam ilginiz için çok teşekkür ederim.yazdığınız kodu denedim,hata vermiyor ama maalesef hiç bir işlemde yapmadı.ben mi bir şeyleri yanlış yaptım anlayamadım.

 

[Korhan Ayhan]

Kodu bir butona tanımlayıp kullanabilirsiniz.

Eklediğiniz örnek dosyaya göre sonuç veriyor.

Sonuçların %100 doğru olduğunu söyleyemem. Anladığım kadarıyla kurguladım. Eksikleri olabilir.

 

[aybekcan]

çok teşekkür ederim,çok güzel çalışıyor.hata benden kaynaklanmış.elinize sağlık.

 

[aybekcan]

hocam sizden macro yazmak konusunda bir tavsiye alabilir miyim? yazılan macroların kodlarını satır satır anlatan detaylı bir kitap öneriniz var mı acaba?bende ki kitap sadece macroda kullanılan fonksiyon ve prosedürlerin neler olduğunu anlatmış geçmiş. Kod içerisinde nasıl kullanılacağını detaylı anlatmamış.