• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Kapalı dosyaki sayfalardan Ado ile sorgu-mükerrer kayıtları getirme

Katılım
3 Eylül 2008
Mesajlar
35
Excel Vers. ve Dili
2007
Üstadlar,

Ekteki zip dosyası içinde çalışma var.

Sorunum şu:
Sorgulama yaptıgım kelımeden bırkac tane (AMA BAĞLANTILI SATIRLAR FARKLI) oldugunda "" sadece bir tanesini"" alıyor.Diğerlerinide (aynı kelıme ile ilgili olan diğer satırlarıda çekmek üzere) alt satırlara almasını sağlamak için ne yapabılırım.
 

Ekli dosyalar

Son düzenleme:
konu hakkında yardım talebim devam ediyor

ADo mükerrer kayıtları sorgulama
 
Merhaba

Gönderdiğiniz dosyada Düşeyara ile veri getirildiği için sadece ilk bulduğu veriyi getirir.
Ekli listedeki çalışmayı inceleyiniz.Mükerrer kayıtlarıda getirir.İstediğiniz kolona görede tekli veya çoklu sorgulama yapabilirsiniz.
 

Ekli dosyalar

teşekkür ederim.Ama,

ilave olarak veri sayfasından daha fazla veri sayfası olursa yani veri2 sayfası olursa ve mükerrerlik olursa kod da ne tür bir değişiklik yapabilirim.
 
vermiş oldugunuz linklerden cok vakıf olmadıgım bır konu oldugundan verım alamadım.

Evet ilk vermıs oldugunuz calışmadakıne ek olarak diğer sayfalardan da veri almasını ıstıyrum.


Tekrar teşekkurler
 
Tüm sayfaların listesini aşağıdaki gibi alabilirsiniz.

Kod:
Sub test()
Dim t As Variant
    For Each t In enum_tables("c:\data.xls")
        MsgBox t
    Next
End Sub

Function enum_tables(full_name As String)
Dim arr() As String, cn As String, cat As Object, t As Object, s As Integer

    cn = "Driver={Microsoft Excel Driver (*.xls)}; DBQ=" & full_name
          
    Set cat = CreateObject("adox.catalog")
    
    cat.activeconnection = cn
    
    For Each t In cat.tables
        If t.Type = "SYSTEM TABLE" Then
            s = s + 1
            ReDim Preserve arr(1 To s)
            arr(s) = "[" & t.Name & "]"
        End If
    Next
    
    cat.activeconnection = Nothing
    enum_tables = arr
End Function
 
konu hakkında yardım talebim devam ediyor

Sn Zeki Gürsoy yapmaya çalıştım ama olması.sorun Sn Zafer in 4.nolu mesajındakı çalışmaya yonelık olarak veri sayfası gibi birkaç sayfa daha olursa örenğin veri2 veri3 gibi....bunlardan da sorgulamayı yapabılırmıyız
 
Dikkat ettiyseniz tüm sayfaları listeliyor. Kaç sayfa varsa veri alma işlemi o kadar tekrar edecek demektir.

Kod:
For Each t In enum_tables("c:\data.xls")
        varialma_işlemi(t)
Next
 
Merhaba

Ekli dosyayı inceleyiniz tek ve çoklu sayfadan veri alabilmektedir

Kapalı dosyadan sayfa isimlerini almak için dosyaya Sayın Zeki bey'in daha önce kullandığı kodlar uyarlanmıştır.
 

Ekli dosyalar

Bu konuda bende bir kod ekliyorum kapalı dosyaya ait sayfa isimlerini A sutünuna listeliyor sayfa isimlerinin arasında boşluk olsa bile listeliyor.


Kod:
Sub sayfaisimlerini_yaz()
Dim Katalog As Object, Data As Object, Tablo As Object
Dim son1, sat
Set Data = CreateObject("ADODB.Connection")
Set Katalog = CreateObject("ADOX.Catalog")
Dosya_Yolu = ("C:\Data.xls")
Data.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};Dbq=" & Dosya_Yolu & ";"
Katalog.ActiveConnection = Data
For Each Tablo In Katalog.tables
If InStr(1, Tablo.Type, "TABLE") > 0 Then
If Right(Tablo.Name, 19) <> "kaynağından_sorgula" Then
If Right(Tablo.Name, 14) <> "Yazdırma_Alanı" Then
son1 = Replace(Tablo.Name, "'", "")
If Right(son1, 1) <> "_" Then
If Right(son1, 1) = "$" Then
sat = sat + 1
Cells(sat, 1) = Left$(son1, Len(son1) - 1)
End If
End If
End If
End If
End If
Next
Set Data = Nothing
Set Katalog = Nothing
End Sub
 
Tüm sayfaların listesini aşağıdaki gibi alabilirsiniz.

Kod:
Sub test()
Dim t As Variant
    For Each t In enum_tables("c:\data.xls")
        MsgBox t
    Next
End Sub

Function enum_tables(full_name As String)
Dim arr() As String, cn As String, cat As Object, t As Object, s As Integer

    cn = "Driver={Microsoft Excel Driver (*.xls)}; DBQ=" & full_name
          
    Set cat = CreateObject("adox.catalog")
    
    cat.activeconnection = cn
    
    For Each t In cat.tables
        If t.Type = "SYSTEM TABLE" Then
            s = s + 1
            ReDim Preserve arr(1 To s)
            arr(s) = "[" & t.Name & "]"
        End If
    Next
    
    cat.activeconnection = Nothing
    enum_tables = arr
End Function

--------------------------------------------------------------------------------
banada yardımcı olabilir misiniz? Örnek dosya gönderebilirsiniz.
Bir excel dosyasından diğer makinede bulunan excel dosyasını açmadan veri yazmak istiyorum. Ancak benim belirlediğim kritere göre yazmasını istiyorum. istediğim sıra numarasını bulacak ve bu satırda istediğim sütunlara yazacak örneğin açık excell dosyasında 7. satırı belirlediysem belirlediğim 3 hücreyi b7,c7,d7 hücrelere yazacak. işlem yaptığım dosyadan diğer makinede bulunan dosyayı açmadan işlem yapmak istiyorum. Bunu makro ile yapmam mümkün mü? Makro deneyimim olmadığı için soruyorum.Yardımcı olacak arkadaşa şimdiden teşekkürü bir borç bilirim.
 
Bu konuda bende bir kod ekliyorum kapalı dosyaya ait sayfa isimlerini A sutünuna listeliyor sayfa isimlerinin arasında boşluk olsa bile listeliyor.


Kod:
Sub sayfaisimlerini_yaz()
Dim Katalog As Object, Data As Object, Tablo As Object
Dim son1, sat
Set Data = CreateObject("ADODB.Connection")
Set Katalog = CreateObject("ADOX.Catalog")
Dosya_Yolu = ("C:\Data.xls")
Data.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};Dbq=" & Dosya_Yolu & ";"
Katalog.ActiveConnection = Data
For Each Tablo In Katalog.tables
If InStr(1, Tablo.Type, "TABLE") > 0 Then
If Right(Tablo.Name, 19) <> "kaynağından_sorgula" Then
If Right(Tablo.Name, 14) <> "Yazdırma_Alanı" Then
son1 = Replace(Tablo.Name, "'", "")
If Right(son1, 1) <> "_" Then
If Right(son1, 1) = "$" Then
sat = sat + 1
Cells(sat, 1) = Left$(son1, Len(son1) - 1)
End If
End If
End If
End If
End If
Next
Set Data = Nothing
Set Katalog = Nothing
End Sub

--------------------------------------------------------------------------------
Banada yardımcı olabilir misiniz? Örnek dosya gönderebilir misiniz mesaj olarak
Bir excel dosyasından diğer makinede bulunan excel dosyasını açmadan veri yazmak istiyorum. Ancak benim belirlediğim kritere göre yazmasını istiyorum. istediğim sıra numarasını bulacak ve bu satırda istediğim sütunlara yazacak örneğin açık excell dosyasında 7. satırı belirlediysem belirlediğim 3 hücreyi b7,c7,d7 hücrelere yazacak. işlem yaptığım dosyadan diğer makinede bulunan dosyayı açmadan işlem yapmak istiyorum. Bunu makro ile yapmam mümkün mü? Makro deneyimim olmadığı için soruyorum.Yardımcı olacak arkadaşa şimdiden teşekkürü bir borç bilirim.
 
Geri
Üst