Skip to main content

AccessTr.neT


Birden Çok Çalışma Kitabından Verileri Tek Dosyada Birleştirme

Birden Çok Çalışma Kitabından Verileri Tek Dosyada Birleştirme

#13
(14/11/2020, 00:11)feraz yazdı: Son satır ve sütun yerleri değişken oluyor diye anlamıştım sanki kapalı dosyada ilk mesajda.Ado ilede bunun için yaptınızmı abey.
Mesela kapalı dosyada birine sırano 2.satır oluken diğerinde üçüncü satır felan.
kastettiginizi tam olarak anlamadim, dosya yapilari özdeş degilmiydi? Cok dikkat etmedim ama sizin sonuclar ile benimki aynı gibi geldi.
Cevapla
#14
(14/11/2020, 00:15)berduş yazdı:
(14/11/2020, 00:11)feraz yazdı: Son satır ve sütun yerleri değişken oluyor diye anlamıştım sanki kapalı dosyada ilk mesajda.Ado ilede bunun için yaptınızmı abey.
Mesela kapalı dosyada birine sırano 2.satır oluken diğerinde üçüncü satır felan.
kastettiginizi tam olarak anlamadim, dosya yapilari özdeş degilmiydi? Cok dikkat etmedim ama sizin sonuclar ile benimki aynı gibi geldi.
Bende anlayamadım işin açığı ilk mesajdaki.Aynı gelmesi sebebi Kapalı dosyadaki A ve B olan Excel içindeki veriler aynı olduğu için.Yani yanlış hatırlamıyorsam ikisidr 2.satırdan başlıyordu başlıklar.Meseka B olan Excel sütun başlık 3.satırdan başlarsa demek istemiştim.
Cevapla
#15
Ozaman rekordset yeni bir kriter eklemek yeterlidir diye düşünüyordum kimlikno alani ciftsayi mi kontrol edilebilir yada baslik alanindaki bir kelimeye esit degilse de denebilir. Ilk mesajdaki aciklama net olmadigi icin daha ayrintili bir aciklama istemistim ama sizin paylastiginiz gifteki sonucu gorunce bu yontemi kullandim
Cevapla
#16
(14/11/2020, 00:28)berduş yazdı: Ozaman rekordset yeni bir kriter eklemek yeterlidir diye düşünüyordum kimlikno alani ciftsayi mi kontrol edilebilir yada baslik alanindaki bir kelimeye esit degilse de denebilir. Ilk mesajdaki aciklama net olmadigi icin daha ayrintili bir aciklama istemistim ama sizin paylastiginiz gifteki sonucu gorunce bu yontemi kullandim
Bende zaten kapalıdaki ilk satır bulmayı kodno olması gerek yanılmıyorsam(Asütundaki başlık adı) bunu kapalı dosyada kelime olarak aratmıştım find ile.Kayıt kelimesinide kapalı excelde bu kelimeyi aratıp son sütun noyu bulmuştum Img-grin
Aynı yöntem Ado ilede yapılabilir abey Img-grin belki.
Önceden ado ile son satır no bulma olayı için dosya arşivlemiştim öylede olur böylede Img-grin
Neyse artık üstad hangisini kullanırsa kullansın alternatif çözümler iyidir herzaman.
Cevapla
#17
(13/11/2020, 22:37)berduş yazdı: bu da Recordsetli yöntem
Not: 'Önce referanslardan Microsoft ActiveX Data Objects x.x  library eklenmeli
'x.x yerine bilgisayardaki sürüm olmalı
'Microsoft ActiveX Data Objects 2.0 Library
'Microsoft ActiveX Data Objects 2.8 Library
'Microsoft ActiveX Data Objects 6.0 Library  gibi
Sub ImportDataFromMultipleWorkbooks()

Dim vaFiles As Variant
Dim ws As Worksheet

ThisWorkbook.Activate

Set ws = Sayfa1

un = "Sayın " & Environ("UserName")

ms1 = MsgBox("Birden fazla dosyadan veri almak istiyor musunuz?", vbInformation + vbYesNo, un)
If ms1 = vbYes Then
    ws.Range("A3:K" & Rows.Count).Clear
   
    vaFiles = Application.GetOpenFilename( _
    FileFilter:="Microsoft Excel Workbooks(*.xls;*.xlsx;*.xlsb;*.xlsm),*.xls;*.xls;*.xlsx;*.xlsb;*.xlsm", _
    Title:="Select Files to Proceed", MultiSelect:=True)
   
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
   
    If IsArray(vaFiles) Then
        For i = LBound(vaFiles) To UBound(vaFiles)
                   
            If vaFiles(i) = ThisWorkbook.FullName Then
                ms4 = MsgBox("Cannot Open Itself", vbExclamation, un)
                GoTo skipfile:
            End If

'hy Recordset___________________________
Dim Sql As String
Dim ADO_RS As ADODB.Recordset
Dim ADO_CN As ADODB.Connection
   
sonStr = ws.Range("A" & Rows.Count).End(3).Row + 1
SQL = "SELECT * " & _
      "FROM [Sayfa1$A3:I] " & _
      "where [F2]  Is Not Null"

Set ADO_RS = New ADODB.Recordset
Set ADO_CN = New ADODB.Connection

ADO_CN.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;data source=" & vaFiles(i) & _
                          ";extended properties=""excel 12.0;hdr=no"""
ADO_CN.Open
ADO_RS.Open SQL, ADO_CN, 3, 1
'
'  Eğer Hiç Kayıt Yoksa
If ADO_RS.RecordCount = 0 Then
    MsgBox "Kayıt Bulunamadı.", vbCritical, "Veri Yok"
    GoTo skipfile:
End If
ADO_RS.MoveLast
ADO_RS.MoveFirst

ws.Range("A" & sonStr).CopyFromRecordset ADO_RS 'excelde

skipfile:
ADO_RS.Close
ADO_CN.Close
Set ADO_RS = Nothing
Set ADO_CN = Nothing
'_______________________________________

Next i
        ws.Range("A2:K2").EntireColumn.AutoFit
        ms5 = MsgBox("Verileriniz ana dosyaya aktarılmıştır", vbInformation, un)
    Else
        ms3 = MsgBox("Dosya seçmediniz!", vbExclamation, un)
    End If
Else
    ms2 = MsgBox("Başarısız!", vbInformation, un)
End If

With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With

End Sub
Çok güzel anlatmışsın ama ben anlayamadım. Temel bilgisayar bilgim var ama bilmediğim ilk gördüğüm işlemlere gelince afallıyorum. 
"Not: 'Önce referanslardan Microsoft ActiveX Data Objects x.x  library eklenmeli " kısmını anlayamadım. baktım aradım ama bulamadım. Çok basit bi detay olduğunun farkındayım. 
Bu arada @feraz hocam kod uyguladım çalıştı. "
Set ws = ThisWorkbook.Sheets("Sayfa1")" 
sayfa1 yerine sheet adını yazmam gerekiyordu sonradan farkettim.
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task