tahsinanarat
Altın Üye
- Katılım
- 14 Mart 2005
- Mesajlar
- 2,164
- Excel Vers. ve Dili
- Ofis 2019 Türkçe
- Altın Üyelik Bitiş Tarihi
- 27-05-2028
Kod:
Sub TestQuery3()
'Haluk 11/12/2022
'
Dim myDB As String, adoCN As Object, strSQL As String, RS As Object, j As Integer
Sheets("Guncelpersonellistesi").Range("a1") = "SİCİL"
Const adOpenDynamic = 1
Const adLockOptimistic = 3
myDB = ThisWorkbook.FullName
Sheets("Rapor").Cells.ClearContents
Set adoCon = CreateObject("ADODB.Connection")
Set RS = CreateObject("ADODB.RecordSet")
adoCon.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & myDB & ";Extended Properties= 'Excel 12.0; HDR=Yes'"
strSQL = "Transform Format(Max([TARİH]),'dd.mm.yyyy')" & _
"Select Table1.[SİCİL], " & _
"Table2.[ADI VE SOYADI], Table2.[CİNSİYET], Table2.[İŞE GİRİŞ], Table2.[TC KİMLİK NO] , Table2.[birimi], Table2.[durumu]" & _
"From [Arsiv$] as Table1 " & _
"Left Join " & _
"[GuncelPersonelListesi$] As Table2 " & _
"On Table1.[SİCİL] = Table2.[SİCİL] " & _
"Group By Table1.[SİCİL], Table2.[ADI VE SOYADI], Table2.[CİNSİYET], Table2.[İŞE GİRİŞ], Table2.[TC KİMLİK NO] , Table2.[birimi], Table2.[durumu]" & _
"Pivot Table1.[TÜR] "
RS.Open Source:=strSQL, ActiveConnection:=adoCon, CursorType:=adOpenDynamic, LockType:=adLockOptimistic
For j = 0 To RS.Fields.Count - 1
Sheets("Rapor").Cells(1, j + 1) = RS.Fields(j).Name
Next
Sheets("Rapor").Range("A2").CopyFromRecordset RS
RS.Close
Set RS = Nothing
Set adoCon = Nothing
Range("A1") = "C:\FOTO\"
Range("H1") = "NOT EKLE"
' bul_sil
Rows("2:2").Select
Selection.Delete Shift:=xlUp
Range("B2").Select
Sheets("Guncelpersonellistesi").Range("a1") = "C:\FOTO\"
End Sub
Ben ilaveten Arşiv sayfasında en son tarihin sağına birde G sutunundan Malzeme Adı nıda Rapor sayfasına aldırmak istiyorum.
Yardımcı olabilirmisiniz. Teşekkürler
Ekli dosyalar
-
56.5 KB Görüntüleme: 9
Son düzenleme: