klasörlerdeki sanıklar adlı sayfaları birleştirme

[tahsinanarat]

Sn. Halit hocam ilgilendiğiniz için çok teşekkür ediyorum, magdurlarında aynı sayfada (sanıklar sayfasında) satırın devamına gelmesini istiyordum, sanırım yanlış ifade etmişim.
Birde Bilgiler sayfasındaki dataların gelmesi gereken yere Sanıklara ait bilgiler geliyor. Bakabilirseniz sevinirim. Saygılar .

 

[halit3]

Bunu denrmisin

Dim Klasor As Object
Dim Obj As Object
Dim Kaynak As String
Dim sat As String
Private Sub CommandButton1_Click()
a = MsgBox("Dosyalardan veri almak istiyormusunuz..?", vbYesNo, " Tablo")
If a = vbNo Then
Exit Sub
End If
Range(Cells(2, 1), Cells(Rows.Count, Columns.Count)).Value = ""
sat = 2
sat1 = 2
On Error Resume Next
Dim Baslik As String
Baslik = "Kaynak Dosyaları İçeren Klasörü Seçin"
Set Obj = CreateObject("shell.application")
Set Klasor = Obj.browseforfolder(0, Baslik, 50, &H0)
Kaynak = Klasor.Items.Item.Path
If Not Klasor Is Nothing Then
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
On Error Resume Next
Liste (Klasor.Items.Item.Path)
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
    
Set Obj = Nothing
Set Klasor = Nothing
Exit Sub
Hata: MsgBox Err.Description, vbExclamation, "Error #" & Err.Number
End Sub
 
Private Sub Liste(Yol As String)
Dim fL As Object, f As Object, Dosya As String, r As Long, i As Long
Set fL = CreateObject("Scripting.FileSystemObject").getfolder(Yol).SubFolders
Dim wb As Workbook
Dosya = Dir(Yol & "\*.*")
While Dosya <> ""
DoEvents
If ThisWorkbook.Name <> Dosya Then
On Error Resume Next
Application.DisplayAlerts = False
tmp = Dosya
deg = "'" & Kaynak & "\" & "[" & tmp & "]" & "Bilgiler" & "'!R"
deg1 = "'" & Kaynak & "\" & "[" & tmp & "]" & "SANIKLAR" & "'!R"
deg2 = "'" & Kaynak & "\" & "[" & tmp & "]" & "MAGDUR_MUSTEKİLER" & "'!R"
For r = 2 To 11
If ExecuteExcel4Macro(deg1 & 3 & "C" & r) <> "" Then
Cells(sat, 1) = ExecuteExcel4Macro(deg & "2C2")
Cells(sat, 2) = ExecuteExcel4Macro(deg & "3C2")
Cells(sat, 3) = ExecuteExcel4Macro(deg & "4C2")
Cells(sat, 4) = ExecuteExcel4Macro(deg & "5C2")
Cells(sat, 5) = ExecuteExcel4Macro(deg & "7C2")
For i = 3 To 77
Cells(sat, i + 3) = ExecuteExcel4Macro(deg1 & i & "C" & r)
Cells(sat, i + 78) = ExecuteExcel4Macro(deg2 & i & "C" & r)
If Cells(sat, i + 3) = 0 Then
Cells(sat, i + 3) = ""
End If
If Cells(sat, i + 78) = 0 Then
Cells(sat, i + 78) = ""
End If
Next i
sat = Cells(Rows.Count, "f").End(3).Row + 1
End If
Next r
End If
Dosya = Dir
Wend
On Error GoTo sonraki
For Each f In fL
Kaynak = f.Path
Liste (f.Path)
sonraki:
Next
Set fL = Nothing
End Sub

 

[tahsinanarat]

Sn. Halit hocam, kodları denedim ama olmamış. Şimdi sorumu baştan alıyorum.
16.nolu mesajınızda verdiğiniz cevap mükemmel. Buraya kadar herşey tamam. Benim istediğim bu 16.nolu mesajınızdaki kodlara ilaveten MAGDUR_MUSTEKİLER sayfasındaki bilgilerinde aynı ceraim numarasına ilaveten CB sutunundan devam etmesidir.
örneğin, bir klasördeki sanıklar çalışma kitabını açtı, Bilgiler sayfasından (a-e sutununa katar) dataları yazdı, f sutunundan itibaren de kaç sanık varsa o kadar satır datalarıda aldı, aynı ceraime ait kaç tane magdur varsa bu mağdurlarıda o ceraim numarasının satırına devam etmesi, buda örneğimizde cb sutunundan başlıyor.

 

[halit3]

Sn. Halit hocam, kodları denedim ama olmamış. Şimdi sorumu baştan alıyorum.
16.nolu mesajınızda verdiğiniz cevap mükemmel. Buraya kadar herşey tamam. Benim istediğim bu 16.nolu mesajınızdaki kodlara ilaveten MAGDUR_MUSTEKİLER sayfasındaki bilgilerinde aynı ceraim numarasına ilaveten CB sutunundan devam etmesidir.
örneğin, bir klasördeki sanıklar çalışma kitabını açtı, Bilgiler sayfasından (a-e sutununa katar) dataları yazdı, f sutunundan itibaren de kaç sanık varsa o kadar satır datalarıda aldı, aynı ceraime ait kaç tane magdur varsa bu mağdurlarıda o ceraim numarasının satırına devam etmesi, buda örneğimizde cb sutunundan başlıyor.

22 nolu mesajdaki kodu yeniden düzenledim.

 

[tahsinanarat]

Sn. Halit hocam sizi çok fazla yordum, mağdur kısmınıda ayrı çekip manuel olarak birleştirmeye karar aldım,
Bu son kodlarda sanki magdur sayısı sanık sayısından fazla olan dosyada takılıp kalıyor, bir sonraki dosyaya geçmiyor ve herhangi bir hata mesajı da vermiyor. Sizi daha fazla yormak istemiyorum. Yardımlarınız için tekrar teşekkür ediyorum. Saygılar.

 

[halit3]

Sn. Halit hocam sizi çok fazla yordum, mağdur kısmınıda ayrı çekip manuel olarak birleştirmeye karar aldım,
Bu son kodlarda sanki magdur sayısı sanık sayısından fazla olan dosyada takılıp kalıyor, bir sonraki dosyaya geçmiyor ve herhangi bir hata mesajı da vermiyor. Sizi daha fazla yormak istemiyorum. Yardımlarınız için tekrar teşekkür ediyorum. Saygılar.

Bu örnek dosyaya göre sanıklar sayfasına veriler geliyor.

 

[tahsinanarat]

Evet hocam sizin söylemeniz üzerine örnek dosyalarda denedim, çok seri bir şekilde veriler geliyor, gerçek dosyalardan 25 adet klasörde denediğimde tek bir ceraimi alıyor sonra uzun süre beklemede kalıyor. Neden olabilir diye araştırıyorum şimdi. Emeğinize çok çok teşekkür ediyorum. Eğer bulamazsam bir kaç örnek dosya daha ekleyip size soracağım neden olabilir diye. Saygılar.

 

[tahsinanarat]

Sn. Halit hocam elinize sağlık, hakkınızı helal edin, çok zahmet verdim, evdeki bilgisayarımda denediğimde herhangi bir problem yaşamadım, bekleme yapmadan devam ediyor. Çok teşekkür ediyorum. Saygılar.

 

[halit3]

Sn. Halit hocam elinize sağlık, hakkınızı helal edin, çok zahmet verdim, evdeki bilgisayarımda denediğimde herhangi bir problem yaşamadım, bekleme yapmadan devam ediyor. Çok teşekkür ediyorum. Saygılar.

İyi çalışmalar