hmtstc
Altın Üye
- Katılım
- 20 Şubat 2014
- Mesajlar
- 314
- Excel Vers. ve Dili
- Excel 2016 - Türkçe
- Altın Üyelik Bitiş Tarihi
- 10-04-2025
Merhaba,
Aşağıdaki kodu basitçe yazmaya çalıştım başta. Soru olursa yine cevaplarım.
Sistemi açıklayayım
Ayrı bir kayıpliste.xlsx olarak dosyam var, buradan belirli tarih aralığında olan verileri çekmek istiyorum. kayıpliste.xlsx dosyası SAP uygulamasından çekilen bir rapor. Yani o raporu hiç bir şekilde açmadan işlem yapmak istiyorum.
1 hafta +1 gün şeklinde sorgu çekmek istiyorum. Ben gün gün tarihleri girdim ama bunu da başaramadım. Seçilen 2 tarih aralığında raporu çekmek mümkün müdür ?
Dosyaları ekledim, desteğiniz için şimdiden teşekkür ederim.
Aşağıdaki kodu basitçe yazmaya çalıştım başta. Soru olursa yine cevaplarım.
Sistemi açıklayayım
Ayrı bir kayıpliste.xlsx olarak dosyam var, buradan belirli tarih aralığında olan verileri çekmek istiyorum. kayıpliste.xlsx dosyası SAP uygulamasından çekilen bir rapor. Yani o raporu hiç bir şekilde açmadan işlem yapmak istiyorum.
1 hafta +1 gün şeklinde sorgu çekmek istiyorum. Ben gün gün tarihleri girdim ama bunu da başaramadım. Seçilen 2 tarih aralığında raporu çekmek mümkün müdür ?
Dosyaları ekledim, desteğiniz için şimdiden teşekkür ederim.
Sub yenikayıpsorgulama()
Application.ScreenUpdating = False
Set anasayfa = Sheets("1.BÜLTEN")
kullanıcı = Environ("UserName")
Dim gun1, gun2, gun3, gun4, gun5, gun6, gun7, gun8 As String
'Dim kayiptiptanim As String
'Dim kayipdetaytanim As String
'Dim sippno As String
'Dim malzeme As String
anasayfa.Select
gun1 = anasayfa.Cells(7, 37)
gun2 = anasayfa.Cells(8, 37)
gun3 = anasayfa.Cells(9, 37)
gun4 = anasayfa.Cells(10, 37)
gun5 = anasayfa.Cells(11, 37)
gun6 = anasayfa.Cells(12, 37)
gun7 = anasayfa.Cells(13, 37)
gun8 = anasayfa.Cells(14, 37)
Sheets("Kayıplar").Select
'sorgudosyası = Application.GetOpenFilename("Excel Files, *.xlsx", 1, "Lütfen Kaynak Dosyayı Seçiniz", True)
sayfaismi = "Sheet1"
eski = WorksheetFunction.Max(2, Cells(Rows.Count, "A").End(3).Row)
Range(Cells(2, 1), Cells(eski, 11)).ClearContents
yol = ThisWorkbook.Path
hedefkitap = "kayıpliste.xlsx"
tümü = yol & "\" & hedefkitap
Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & tümü & ";extended properties=""Excel 12.0;hdr=no"""
sorgu = "select F1,F2,F3,F4,F5,F6,F7,F8,F9,F10,F11 " & _
"from[" & sayfaismi & "$A2:K50000] where F5 =" & gun1
''& "' or F5='" & gun2 & "' or F5='" & gun3 & "' or F5='" & gun4 & "' or F5='" & gun5 & "' or F5='" & gun6 & "' or F5='" & gun7 & "' or F5='" & gun8 & "'"
' MsgBox sorgu
Set rs = con.Execute(sorgu)
Range("A2").CopyFromRecordset rs
anasayfa.Select
End Sub
Ekli dosyalar
-
98.9 KB Görüntüleme: 10
-
1 MB Görüntüleme: 10