satir aktarma

[dennisf06]

Merhaba

23.03.2008, 24.04.2008, 07.05.2008 seklinde dosya adlari vererek veri almak istegim dosyalari günlük olarak tutuyorum. her biri ayri bir calisma kitabidir. calisma kitaplari birbirinin aynisidir. kisi isimlerinin bulundugu satirlar sabittir.

yapmak istedigim ise; kisi adini ve hangi dosyadan veri almak istedigimi tablodaki yerine yazdigim zaman o kisiye ait satirdaki veriler günlük tutulan dosyalardan veri dosyasina gelsin.

yardimlariniz icin simdiden cok tesekkür ederim. saygilarimla.

 

[dennisf06]

acaba satirdaki verilerin aktarilmasi excel de mümkün degil mi ? ya da baska bir yöntem mi denemem gerekiyor. bilgi verirseniz memnun olurum. saygilarimla.

 

[Orion1]

Dosyanız ekte.

Sub aktar()
Dim isim, dosya, yol As String, son As Long ', dsyad As String
Dim i As Long, k As Byte, sat As Long, j As Byte
Sheets("Sayfa1").Select
Range("B12:AK65536").ClearContents
isim = UCase(Replace(Replace(Range("F1").Value, "ı", "I"), "i", "İ"))
yol = ThisWorkbook.Path & "\"
If isim = "" Then
    MsgBox "Rapor Çıkarılmadı..!!" & vbLf & "isim boş olamaz..!!", vbCritical, "UYARI"
    Range("F1").Select
    Exit Sub
End If
sat = 12
For j = 1 To 10
    dosya = UCase(Replace(Replace(Range("C" & j).Value, "ı", "I"), "i", "İ")) & ".xls"
    If Cells(j, "C").Value = "" Then GoTo atla
    If Dir(yol & dosya) = "" Then
        MsgBox "[ " & dosya & " ] Dosya Yolu doğru değil veya dosya yok..!!", vbCritical, "UYARI"
        GoTo atla
    End If
    son = Application.ExecuteExcel4Macro("COUNTA('" & yol & "[" & dosya & "]Ana1'!C1)")
    son = son + 5
    If son < 6 Then
        MsgBox "Bu dosyada veri yok..!!", vbCritical, "UYARI"
        GoTo atla
    End If
    For i = 6 To 35
        dsyad = Application.ExecuteExcel4Macro("'" & yol & "[" & dosya & "]Ana1'!R" & i & "C1")
        dsyad = UCase(Replace(Replace(dsyad, "ı", "I"), "i", "İ"))
        If isim = dsyad Then
            Cells(sat, "A").Value = sat - 11
            Cells(sat, "B").Value = dosya
            Cells(sat, "C").Value = dsyad
            For k = 3 To 36
                Cells(sat, k + 1).Value = Application.ExecuteExcel4Macro( _
                "'" & yol & "[" & dosya & "]Ana1'!R" & i & "C" & k)
            Next k
            sat = sat + 1
        End If
    Next i
atla:
Next j
MsgBox "İşlem tamam..!!", vbOKOnly + vbInformation, Application.UserName
End Sub

 

[dennisf06]

Sn Evren bey öncelikle sorularima gösterdiginiz alakadan dolayi cok tesekkür ederim. sabirla bizlere excel i ögretmeye devam ediyorsunuz.

sorumda can alici bir nokta var, o da bir kac günü veri tablosunda görebilmek. yaptiginiz örnek dosyada sadece istenilen bir günün verilerini görmek mümkün, ama ben aslinda diger günleri de veri tablosuna ayni anda aktarmak istiyorum. problem burda zaten. ( aslinda bunu haftanin alti günü icin uyarlamak istemistim. )
göndermis oldugunuz dosya üzerinde C8 hücresine isim yazip, sirasiyla C9,C10,C11,C12,C13,C14 hücrelerine dosya isimlerini yazarak sorgulama yapilip tabloda alt alta veriler getirilebilir mi ? saygilarimla.

 

[Orion1]

C9dan c14' kadar dosya isimlerini yazıp bu dosyalarda rama yapılacağı konusunu dah önceden belritmeniz gerekridi.
Ayrıca tabnlonuz bu C14 - C19 aralığında dosya isimleri yazmaya göre ayarlı değil.

 

[dennisf06]

kusura bakmayin. aslinda soru dosyasinda sorumu anlasilir bir bicimde anlatmaya calistim. sizin örnek dosyaniza göre C9-C19 araligi sadece bir öneriydi. ayni anda diger dosyadaki veriler de gelsin. bir haftayi komple görmek istiyorum. nasil olursa olsun. yapmak istedigim sadece bu.baska bir öneriniz varsa tabi ki ona da acigim. tesekkür ederim.saygilarimla.

 

[Orion1]

kusura bakmayin. aslinda soru dosyasinda sorumu anlasilir bir bicimde anlatmaya calistim. sizin örnek dosyaniza göre C9-C19 araligi sadece bir öneriydi. ayni anda diger dosyadaki veriler de gelsin. bir haftayi komple görmek istiyorum. nasil olursa olsun. yapmak istedigim sadece bu.baska bir öneriniz varsa tabi ki ona da acigim. tesekkür ederim.saygilarimla.

Dosayayı istediğniz şekilde düzenledim.
3 nolu mesajdan dosyayı indirebilirsiniz.

 

[dennisf06]

Evren bey nasil tesekkür edeyim bilmiyorum ki. tam düsündügüm sey. bir de ayni klasör icinde degilde baska bir klasörde calisirsam dosya yolunu göstermek icin kodun neresini degistirmem lazim. hersey icin tekrar tesekkür ederim. saglicakla kalin. saygilar.

 

[Orion1]

Evren bey nasil tesekkür edeyim bilmiyorum ki. tam düsündügüm sey. bir de ayni klasör icinde degilde baska bir klasörde calisirsam dosya yolunu göstermek icin kodun neresini degistirmem lazim. hersey icin tekrar tesekkür ederim. saglicakla kalin. saygilar.

Dosya Aşağıdaki kod ile aktarılan dosyalar içindeki ayni klasörün içersinde olması gerekiyordu.

yol = ThisWorkbook.Path & "\"

Dosyalar C:\Evren klasörü içersinde ise aşağıdaki kod gibi olmalıdır.

yol = "C:\Evren\

 

[dennisf06]

tesekkür ederim.