Excel dosyalarından sorgulama

[asiiiruzgar]

arkadaşlar üzerinde çalışmış olduğum bir program var hastane ödeme sorgulama adı altında bir sistem lazım bana yardımcı olabilirseniz çok sevinirim ektede dosyayı gönderiyorum kolay gelsin açıklamalı bir şekilde ne istediğim orda yazıyor inşallah mümkündür. mümkün değilse benbi uyarında boşuna ümitlenmeyim.

 

[asiiiruzgar]

Arkadaşlar Lütfen

Arkadaşlar Lütfen Bilgisi olan bir arkadaşım yardımcı olsun
ne olur yardım edin

 

[asiiiruzgar]

yardım

lütfen biri bana cevap yazssın böyle bir şey yoksa mümkün değilmi
biri baksın şu dosyaya lütfennnnn
yardım edin

 

[asiiiruzgar]

Yardimmmmmmm

ArkadaŞlar Şu Dosyalara Bİr Baksaniz LÜtfennnnn

 

[asiiiruzgar]

bilen yokmu acaba

herkeze cevap yazılıyor benimkisi olmayacak bir şeymi lütfenn bir bakın bir cevap yazın yaaaaaaa.

 

[Korhan Ayhan]

Selamlar,

Veri aktarılacak dosyalarınızdan bir örnek eklemermisiniz.

 

[asiiiruzgar]

Dosyalar

Ben Örnek Olarak Hastane Ödeme Sorgulama Kitapçığından
Ankara Üniversitesi Tıp Fakültesini Seçtim. Şimdi benim D diskimde bulunan Hastane Kayıt Dosyasına Girip Ordan Ankara Üniversitesi Tıp Fakülteesi Dosyanı Girip İçinde Bulunan Excel dosyalarını birebir Hastane Ödeme Sorgulamasına Atmasını İstiyorum
Örnektede Elle Yazarak Gönderdim..
İnşallah Olurrr Cevabınızı Bekliyorum Size Kolay Gelsin...

 

[Korhan Ayhan]

Selamlar,

Veri almak istediğiniz klasör ve dosyaları D:\ klasörüne yerleştirip aşağıdaki kodu verileri almak istediğiniz dosyada çalıştırın. Umarım faydası olur.

Sub SORGULA()
    Dim HEDEF_DOSYA As String
    Dim X, SAY As Integer
    Application.ScreenUpdating = False
    [C8:L65536].ClearContents
    With Application.FileSearch
    .LookIn = "D:\" & ActiveSheet.[F3].Value
    .FileType = msoFileTypeExcelWorkbooks
    If .Execute() > 0 Then
    For X = 1 To .FoundFiles.Count
    SATIR = ThisWorkbook.Worksheets(1).[C65536].End(3).Row + 1
    Application.DisplayAlerts = False
    Workbooks.Open (.FoundFiles(X)), UpdateLinks:=0
    HEDEF_DOSYA = ActiveWorkbook.Name
    SAY = Workbooks(HEDEF_DOSYA).Worksheets(1).Range("C65536").End(3).Row
    ThisWorkbook.Worksheets(1).Range("C" & SATIR & ":C" & SATIR + SAY - 12) = Workbooks(HEDEF_DOSYA).Worksheets(1).Range("C12:C" & SAY).Value
    ThisWorkbook.Worksheets(1).Range("D" & SATIR & ":D" & SATIR + SAY - 12) = Workbooks(HEDEF_DOSYA).Worksheets(1).Range("D12:D" & SAY).Value
    ThisWorkbook.Worksheets(1).Range("G" & SATIR & ":G" & SATIR + SAY - 12) = Workbooks(HEDEF_DOSYA).Worksheets(1).Range("G12:G" & SAY).Value
    ThisWorkbook.Worksheets(1).Range("J" & SATIR & ":J" & SATIR + SAY - 12) = Workbooks(HEDEF_DOSYA).Worksheets(1).Range("J12:J" & SAY).Value
    ThisWorkbook.Worksheets(1).Range("L" & SATIR & ":L" & SATIR + SAY - 12) = Workbooks(HEDEF_DOSYA).Name
    Workbooks(HEDEF_DOSYA).Close False
    Next
    Else
    MsgBox "SORGULAMA YAPILACAK DOSYA BULUNAMAMIŞTIR !", vbExclamation
    End If
    End With
End Sub

 

[halilsoft]

dosyalrın bulunduğu klasöre hastane sorgu koyarsan o
hastaneyi seçtiğinde otamatik olarak fatrura bilgilerini sayfaya alıyor. dosya isimlerine tıklayınca da o dosyayı açıyor... umarım işine yarar kolay gelsin...

 

[asiiiruzgar]

Merhaba

Sayın Cost_Control ve Halil bey Çok teşekkür Ederim yanlız Cost Costrolun vermiş olduğu kodlar daha sorunsuz ve daha güzel çalışıyor onun için sayın Cost Controla bir sorum olacak benim dosya yolum farklı kodun neresini değiştirmem lazım

D:\TAHAKKUK İŞLERİ\2007 TAHAKKUK İŞLERİ\PAYLAŞIM\HASTANE KAYIT DOSYASI

sadece D diski değilde bu şekilde nasıl ayarlayabilirim


Hastane Sorgulama Sistemi

 

[Korhan Ayhan]

Selamlar,

Önerdiğim koddaki aşağıdaki kısmı bir sonraki ile değiştirip denermisiniz.

Eski hali;

    .LookIn = "D:\" & ActiveSheet.[F3].Value

Yeni hali;

    .LookIn = "D:\TAHAKKUK İŞLERİ\2007 TAHAKKUK İŞLERİ\PAYLAŞIM\HASTANE KAYIT DOSYASI\" & ActiveSheet.[F3].Value

 

[asiiiruzgar]

Teşekkür Ederim Çok Güzel Çalışıyor ve Oldu Ellerine Sağlık..