kardelen79
Altın Üye
- Katılım
- 18 Mayıs 2018
- Mesajlar
- 492
- Excel Vers. ve Dili
- 2007
- Altın Üyelik Bitiş Tarihi
- 11-06-2025
benimm konu biraz geri de kaldı 30 dk bi bakıyorum ama ya arkadaşlar denk gelmedi
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub csvdosyayukle59()
Dim ilktar As Date, sontar As Date, tar As Date, sat As Long, deg As String, x
Dim a As String, k As Range, j As Integer, sonsat As Long
Range("B6:AME" & Rows.Count).ClearContents
ilktar = Range("AMH1").Value
sontar = Range("AMH2").Value
sonsat = Cells(Rows.Count, "A").End(xlUp).Row
sat = 5
Application.ScreenUpdating = False
For j = 6 To sonsat
If Dir(ThisWorkbook.Path & "\" & Cells(j, "A").Value & ".csv") <> "" Then
Open (ThisWorkbook.Path & "\" & Cells(j, "A").Value & ".csv") For Input As #1
Do While Not EOF(1)
Line Input #1, a
x = Split(a, ";")
deg = x(0)
tar = DateSerial(Left(deg, 4), Mid(deg, 5, 2), Right(deg, 2))
If tar >= ilktar And tar <= sontar Then
Set k = Range("B5:AME5").Find(deg, , xlValues, xlWhole)
Cells(j, k.Column).Value = CDbl(x(4))
'Cells(sat, "B").Value = CDbl(x(1))
'Cells(sat, "C").Value = CDbl(x(2))
'Cells(sat, "D").Value = CDbl(x(3))
'Cells(sat, "E").Value = CDbl(x(4))
'Cells(sat, "F").Value = CDbl(x(5))
'sat = sat + 1
End If
'deg = ""
Loop
Close #1
End If
Next
Application.ScreenUpdating = True
MsgBox "işlem bitti"
End Sub
O sayfanın yanında sayfa yok.Bir tane sayfa var.evet abim onun yanındaki sayfaya işlem yapacaz
Tıklaya bastığında AMH1 ve AMH2 de bulunan tarihler arasında verileri getiriyor.ZP sütunu ve ondan sonraki sütunlara uyan verileri getiriuoyor.Abi tıklaya bastığımda veriler gidiyo
Tarihleri girince o iki tarih arasındaki sütunlar gözükmesini istiyorum
Birde imkan olursa abim tarihler bölümü ana ekran gibi durmasını istiyorum daha olmassa yüksek veya düşük fiyat kismindan böleriz sağa doğru cekeriz