Kapalı Dosyadan İki Tarih Arası Veri Çekme

[ThEeNCi]

Selamlar

Forumda bir çok dosya var ama bir türlü kendime uyarlama yapamadım.
Ağdaki bilgisayardaki kapalı veya açık dosyadan iki tarih arası verilerek veri çekme işlemini nasıl yapabilirim.

Teşekkürler,

 

[asi_kral]

Merhaba
Bu işlemi formül ile mi yapmak istiyorsunuz ?
Yoksa Makro ile mi ?

 

[ThEeNCi]

macro ile yapmak istiyorum

 

[asi_kral]

Merhaba
Bu kodu boş bir module ekleyin ve çalıştırın sonuçları gözlemleyin.

Option Explicit
Sub getir()
Dim YOL As String, KTP As Workbook, S1 As Worksheet, S2 As Worksheet
Dim STR As Long, SBT As Variant
Application.ScreenUpdating = False
YOL = [COLOR="Red"]ThisWorkbook.Path[/COLOR] & "\"
Set S1 = ActiveSheet
SBT = ActiveCell.Address
S1.Range("A7:W" & Rows.Count).ClearContents
Set KTP = Workbooks.Open(YOL & "kapalı dosya.xlsx")
Set S2 = KTP.Sheets("Sayfa1")
STR = S2.Range("A" & Rows.Count).End(xlUp).Row
S2.Range("A1:W" & STR).AutoFilter 1, ">=" & CDbl(S1.Range("A4")), xlAnd, "<=" & CDbl(S1.Range("B4"))
S2.Range("A2:W" & STR).Copy: S1.Range("A7").PasteSpecial
S2.Range("A1:W" & STR).AutoFilter
KTP.Close 0
Range(SBT).Select
Application.ScreenUpdating = True
End Sub

Kırmızı olan bölüme yol bilgisini yazın.
Dosya hiç bir pc de açık olmamalı bu kod ile dosyanızdan gerekli bilgileri alıbilirsiniz.

 

[Erdem Akdemir]

Merhaba,

Dosyanızı kendi masaüstüme çıkardım ve orda denedim.
Yol kısmını düzelterek veri alınacak dosyanızın adresini yazın.
Birde kapalı dosyada veri olmayan sütunları ve satırları bir kereye mahsus silebilir misiniz.

Sub denemem()
son = Cells(Rows.Count, "a").End(3).Row
Range("a7:w" & son).Clear

yol = "C:\Users\" & Environ("username") & "\Desktop\Kapalı Dosya Veri Alma\kapalı dosya.xlsx"

Set con = VBA.CreateObject("adodb.Connection")

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
yol & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select * from [Sayfa1$] WHERE cdate([TARİH]) BETWEEN cdate('" & Range("a4") & "') and cdate('" & Range("b4") & "') "

Set rs = con.Execute(sorgu)

Range("a7").CopyFromRecordset rs

End Sub

 

[ThEeNCi]

\\NEDIM\İş Takip

Ağdaki yeri burası yapamadım hata verdi nasıl yapmam gerekiyor.

Bu arada çok teşekkür ederim.

 

[asi_kral]

\\NEDIM\İş Takip

Ağdaki yeri burası yapamadım hata verdi nasıl yapmam gerekiyor.

Bu arada çok teşekkür ederim.

Bu şekilde dener misiniz ?

Option Explicit
Sub getir()
Dim YOL As String, KTP As Workbook, S1 As Worksheet, S2 As Worksheet
Dim STR As Long, SBT As Variant
Application.ScreenUpdating = False
YOL = "\\NEDIM\İş Takip " & "\"
Set S1 = ActiveSheet
SBT = ActiveCell.Address
S1.Range("A7:W" & Rows.Count).ClearContents
Set KTP = Workbooks.Open(YOL & "kapalı dosya.xlsx")
Set S2 = KTP.Sheets("Sayfa1")
STR = S2.Range("A" & Rows.Count).End(xlUp).Row
S2.Range("A1:W" & STR).AutoFilter 1, ">=" & CDbl(S1.Range("A4")), xlAnd, "<=" & CDbl(S1.Range("B4"))
S2.Range("A2:W" & STR).Copy: S1.Range("A7").PasteSpecial
S2.Range("A1:W" & STR).AutoFilter
KTP.Close 0
Range(SBT).Select
Application.ScreenUpdating = True
End Sub

Ben denedim çalışıyor.

 

[ThEeNCi]

Ne yazık ki "\\NEDIM\İş Takip\kapalı dosya.xlsx" sitesini açamadık.
diyor

 

[asi_kral]

Ne yazık ki "\\NEDIM\İş Takip\kapalı dosya.xlsx" sitesini açamadık.
diyor

Dosyanın başka bilgisayarda açık olmadığına emin misiniz ?
Öyle ise dilerseniz Teamviever ile size özelden yardım edebilirim.
isterseniz özel mesajdan bilgileri atabilirsiniz.
Ben işyerindeki ağda deneme yapıyorum. Normal çalışıyor.

 

[ThEeNCi]

tamam " arası açık kalmış çok teşekkür ederim.
Ellerinize sağlık

 

[asi_kral]

tamam " arası açık kalmış çok teşekkür ederim.
Ellerinize sağlık

Kolay Gelsin.

 

[ThEeNCi]

Selamlar asi_kral

Tekrardan macro lazım oldu aynı dosya içerisinde kapalı ve açık dosya arasında ORD sutunundaki veri ile birbirine ORD satırında günceleme yapılınca macro ile kapalı dosyadan alacak burda günceleme olunca kapalı dosyaya yollayacak anlatabildim inşallah

 

[asi_kral]

Merhaba
Kodu bununla değiştirip dener misinis ?

Private Sub Image1_Click()
Dim YOL As String, KTP As Workbook, S1 As Worksheet, S2 As Worksheet
Dim STR As Long, SBT As Variant
Application.ScreenUpdating = False
YOL = ThisWorkbook.Path & "\"
Set S1 = ActiveSheet
SBT = ActiveCell.Address
S1.Range("A7:W" & Rows.Count).ClearContents
Set KTP = Workbooks.Open(YOL & "kapalı dosya.xlsx")
Set S2 = KTP.Sheets("Sayfa1")
STR = S2.Range("A" & Rows.Count).End(xlUp).Row
S2.Range("A1:W" & STR).AutoFilter 2, ">=" & S1.Range("A4"), xlAnd, "<=" & S1.Range("B4")
If WorksheetFunction.Subtotal(3, S2.Range("A2:A" & STR)) > 0 Then
S2.Range("A2:W" & STR).Copy: S1.Range("A7").PasteSpecial
End If
S2.Range("A1:W" & STR).AutoFilter
KTP.Close 0
Range(SBT).Select
Application.ScreenUpdating = True
End Sub

 

[ThEeNCi]

Merhaba

Bu getirdi fakat dolu satırın sonuna getirmesi lazım ve açık dosyadada aynı ORD numarası ile kapalı dosyaya ORD Numarası olan yere dolu satıra hem ekleme yapacak hemde Ord numara verince o satırdaki kapalı dosyadaki veriyi güncelleyecek

 

[asi_kral]

Anlayamadım tam olarak ne yapacak.
Örneklendirerek anlatır mısınız ?
Dosya üzerinde olursa daha iyi olur.

 

[ThEeNCi]

Selamlar
Kapalı dosyadan Açık dosyaya veri getirmiştiniz açık dosyaya veri geldiğinde dolu satıra, Yazmasını istiyorum. Yani iki dosyada aynı veri olacak,
Ve ord numarası açık satırda değişiklik yapıldığında, Kapalı dosyaya aynı satırı geri yollayacak, Aynı yere yani ord numarasının olduğu satıra

İlk kayıt açık dosyada ve buradan kapalı dosyaya dolu satırına aktarma
Kapalı dosyada bu verilere kayıt giriliyor. Ben o girilen kayıtları açık dosyada geri getirmek İstiyorum.

Bunu ord numarası üzerinden güncelleme olarak düşünüyorum olur'mu bilmiyorum tabi
Yani karşılıklı gönder butonu olacak ord numarası üzerinden güncelleyecek ve al butonu olacak Orada güncellenen ord numarası ile kaydı buraya getirecek

 

[asi_kral]

İnanın anlamakta zorluk çekiyorum. Anladığım şu :
Önce Açık dosyada istediğiniz şartlarda veriler gelecek.
Sonra siz bu verilerde değişiklik yaptığınızda kapalı dosyada değişiklik olmasını istiyorsunuz.
Doğru anlamış mıyım ?
Doğru ise ord kodu tek olmalı çift olursa hangi satırda değişiklik olduğunu saptamamız gerekir.

 

[ThEeNCi]

Doğru anladınız kusura bakmayın yordum sizi

 

[ThEeNCi]

tek oluyor ord numarası

 

[asi_kral]

tek oluyor ord numarası

Dosyanız ekte.
Açık dosyada buton mevcut ona tıklarsanız.