- Katılım
- 15 Mart 2005
- Mesajlar
- 42,603
- Excel Vers. ve Dili
- Microsoft 365 Tr-En 64 Bit
Sanırım çalışmaz..
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sabah 8’den beri uğraşıyorum. Beynim yanmak üzereSanırım çalışmaz..
Sanırım çalışmaz..
DefObj C, E-F, R
Sub vericek()
Range("A:D").ClearContents
Set Rky = CreateObject("adodb.connection")
Set FSO = CreateObject("scripting.filesystemobject")
Set cat = CreateObject("adox.catalog")
For Each evn In FSO.getfolder(ThisWorkbook.Path).Files
If Not evn.Name Like "*" & ThisWorkbook.Name Then
Rky.Open "Provider=Microsoft.ace.oledb.12.0;Data Source=" & _
evn & ";Extended Properties=""Excel 12.0;hdr=no"""
cat.activeconnection = Rky
Set RS = Rky.Execute("Select '" & FSO.GetBaseName(evn) & "',F1,F2,F3,F4,F5 From [" & İCMAL$ & "$A1:E500]")
Range("A65536").End(3)(2, 1).CopyFromRecordset RS
RS.Close: Rky.Close
End If
Next evn
Set RS = Nothing: Set Rky = Nothing: Sorgu = ""
Set FSO = Nothing: Set evn = Nothing
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("B:B")) Is Nothing Then
MsgBox "Çift tıklama yapıldı"
End If
End Sub
Sub Test()
Dim Rng As Range
For Each Rng In Range("B2:B1048576").SpecialCells(xlCellTypeConstants)
Rng = CDate(Rng.Value)
Next
End Sub
bu hatayı verdi hocamBunu deneyiniz.
C++:Sub Test() Dim Rng As Range For Each Rng In Range("B2:B1048576").SpecialCells(xlCellTypeConstants) Rng = CDate(Rng.Value) Next End Sub
Uyguladığınız alanda uyumsuz bir veri var sanırım. Örnek dosya paylaşırsanız duruma bakabilirim.
hocam bu söylediğiniz oldu. tek sıkıntı bu işlemin makrosu nedir?Boş bir hücreye 1 yazın. Sonra bu hücreyi kopyalayın. Tarih olan alanı seçip sağ tıklayın. Özel Yapıştır-Değerleri-Çarp işlemlerini yaparak deneyiniz.
Hocam aynı klasördeki excelden verileri çekmek için yazdığım kod vardı, onu office 365'te kullanıyordum şu an office 2013 pro plusta makro çalışmıyor. hata resmi;Google'da MAKRO KAYDET YÖNTEMİ diye arama yapın. Karşınıza konuyla ilgili videolar gelecektir. İnceleyip kendiniz ilgili kodları oluşturabilirsiniz.
DefObj C, E-F, R
Sub vericek()
Range("A:D").ClearContents
Set Rky = CreateObject("adodb.connection")
Set FSO = CreateObject("scripting.filesystemobject")
Set cat = CreateObject("adox.catalog")
For Each evn In FSO.getfolder(ThisWorkbook.Path).Files
If Not evn.Name Like "*" & ThisWorkbook.Name Then
Rky.Open "Provider=Microsoft.ace.oledb.12.0;Data Source=" & _
evn & ";Extended Properties=""Excel 12.0;hdr=no"""
cat.activeconnection = Rky
Set RS = Rky.Execute("Select '" & FSO.GetBaseName(evn) & "',F1,F2,F3,F4,F5 From [" & İCMAL$ & "$A1:E500]")
Range("A65536").End(3)(2, 1).CopyFromRecordset RS
RS.Close: Rky.Close
End If
Next evn
Set RS = Nothing: Set Rky = Nothing: Sorgu = ""
Set FSO = Nothing: Set evn = Nothing
End Sub