tarihe göre uçuş listesi

[mvarol]

Arkadaşlar merhaba,

Bir konuda yardımcı olursanız sevinirim....

Ek'de bir tablo gönderiyorum..

bu tablonun ilk üç sayfası "ülkeler", son sayfa "uçuş tablosu"...
yapmak istediğim....ülkelerin bulunduğu sayfalardaki uçacak kişi sayıları
tarih sıralamasına göre son sayfadaki uçuş tablosuna atsın...

ama tarih bölümüne tarihleri de otomatik atsın ve sıralı olsun...

yani 27.07'de dubai 5, katar 3
28.07'de kazak 4, dubai 5 gibi..

diğer tablolar güncellendikçe bu tabloda (uçuş tablosu ) güncellesin kendisini...

not : Buradaki tabloyu örnek olarak yaptım....bana yapılış mantığını da basit olarak anlatırsanız esas tabloya uyagulayabileyim....excel konusunda uzman değilim....

selamlar, teşekkürler

 

[Orion1]

Merhaba.
Ekli dosyayı inceleyiniz.
Makro ile yapıldı.

Sub yolcu()
Dim sonsut As Integer, sonsat As Long, i As Long
Dim syf As Worksheet
Sheets("uçuş tablosu").Select
sonsut = Cells(1, 256).End(xlToLeft).Column
adr = Range(Cells(2, 1), Cells(65536, sonsut)).Address
Range(adr).ClearContents
Application.ScreenUpdating = False
For Each syf In Worksheets
If syf.Name <> "uçuş tablosu" Then
    Set n = Range("B1:IV1").Find(syf.Name, , xlValues, xlWhole)
    For i = 2 To Sheets(syf.Name).Cells(65536, "B").End(xlUp).Row
        sonsat = Cells(65536, "A").End(xlUp).Row
        Set k = Range("A2:A65536").Find(Sheets(syf.Name).Cells(i, "B").Value, , xlValues, xlWhole)
        If k Is Nothing Then
            Cells(sonsat + 1, "A").Value = Sheets(syf.Name).Cells(i, "B").Value
        Set c = Range("A2:A65536").Find(Sheets(syf.Name).Cells(i, "B").Value, , xlValues, xlWhole)
        If Not c Is Nothing Then
            If Not n Is Nothing Then
                Cells(c.Row, n.Column) = 1
            End If
        End If
        Else
        Set z = Range("A2:A65536").Find(Sheets(syf.Name).Cells(i, "B").Value, , xlValues, xlWhole)
        If Not z Is Nothing Then
            If Not n Is Nothing Then
                Cells(z.Row, n.Column).Value = Cells(z.Row, n.Column) + 1
            End If
        End If
        End If
    Next i
End If
Next
Application.ScreenUpdating = True
MsgBox "YOLCU TOPLAMI YAPILDI..", vbOKOnly + vbInformation

End Sub

 

[muygun]

Slm.
Alternatif Bir çözümde benden (işlevlerle)
Excelin sınırları oranında sayfa ilavesi yapabilirsiniz.

 

[mvarol]

teşekkür

teşekkürler arkadaşlar