• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

TEXT dosyasından veri alma

üsdat yine 1. satırdan itibaren aktarıyor
Cells(Satır - 8, 3) = Mid(Kayıt, 1, 6) burdaki eksi(-) ifadelerinin hepsini artı(+) yaptım bu kez de 18. satırdan itibaren aktarmaya başladı.
 
üsdat yine 1. satırdan itibaren aktarıyor
Cells(Satır - 8, 3) = Mid(Kayıt, 1, 6) burdaki eksi(-) ifadelerinin hepsini artı(+) yaptım bu kez de 18. satırdan itibaren aktarmaya başladı.

Böyle denermisiniz.

Kod:
Sub ZCD_28_VERİ_AKTAR()
Dim Satır As Long, sat As Long
Range("A1:Z65000").ClearContents
dosya = Application.GetOpenFilename(filefilter:="Metin dosyaları(*.txt),(*.txt)", Title:="Bir metin dosyası seçiniz.")
If dosya = False Then Exit Sub
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
Open dosya For Input As #1
Do While Not EOF(1)
Line Input #1, Kayıt
sat = sat + 1
If sat > 8 Then
Satır = Satır + 1
Cells(Satır, 3) = Mid(Kayıt, 1, 6)
Cells(Satır, 4) = Mid(Kayıt, 8, 6)
Cells(Satır, 5) = Mid(Kayıt, 15, 11)
Cells(Satır, 6) = Mid(Kayıt, 27, 11)
Cells(Satır, 7) = Mid(Kayıt, 39, 1)
Cells(Satır, 8).NumberFormat = "@"
Cells(Satır, 8) = Mid(Kayıt, 41, 2)
End If
Loop
Close #1
Cells.EntireColumn.AutoFit
MsgBox "İŞLEM TAMAM"
End Sub
 
hocam ilk gönderdiğiniz cevap daki makro üzerinde aşağıdaki gibi bir değişiklik yaptım
demiştim ya - yi + yaptım 18.satırdan başladı diye bende 8 leri 1 yaptım şuanda oldu son şekli aşağıdaki gibi

emeğiniz için teşekkür ediyorum

Sub ZCD_28_VERİ_AKTAR_5()
Dim i As Long, deg As String, sat As Long, deg2, k As Byte, dosya
Range("A1:JW65536").ClearContents
ChDir (ThisWorkbook.Path)
dosya = Application.GetOpenFilename(filefilter:="Metin dosyaları(*.txt),(*.txt)", Title:="Bir metin dosyası seçiniz.")
If dosya = False Then Exit Sub
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
Open dosya For Input As #1
Do While Not EOF(1)
Line Input #1, Kayıt
Satır = Satır + 1
If Satır > 7 Then
Cells(Satır + 1, 3) = Mid(Kayıt, 1, 6)
Cells(Satır + 1, 4) = Mid(Kayıt, 8, 6)
Cells(Satır + 1, 5) = Convert(Mid(Kayıt, 15, 11))
Cells(Satır + 1, 6) = Convert(Mid(Kayıt, 27, 11))
Cells(Satır + 1, 7) = Convert(Mid(Kayıt, 39, 1))
Cells(Satır + 1, 8).NumberFormat = "@"
Cells(Satır + 1, 8) = Mid(Kayıt, 41, 2)
End If
Loop
Close #1
Cells.EntireColumn.AutoFit
End Sub
 
arkadaşlar texden veri alama güzel bir örnek ekliyorum
emeği geçenlere teşekkür ediyorum

burda
1-text dosyasını seçebiliyorsunuz
2-hangi satır ve sutundan itibaren veriler eklensin istiyorsanız seçebiliyorsunuz
3- texde bulunan hangi aralığı hangi sutuna aktarmasını istiyorsanız onuda seçebiliyorsunuz

makronun çalıştığı excel dosyasını ve örnek text dosyasını ekliyoryorum
ekdeki dosya optik okuyucudan geçirilen sınav kağıtlarının excele aktarılması örneğidir

yukarıdaki bilgi akışını okumak menfaatinize olacaktır.
iyi çalışmalar
 

Ekli dosyalar

unutmadan halit hocam
son göderdiğiniz makroda yine ilk satırdan itibaren alıyor

ilginize teşekkür ediyorum
 
Son düzenleme:
HOCAM
aslında siz doğru yapmışsınız ancak ben yanlış ifade etmişim

Text dosyasının 9. satırından itibaren değil
Excel'deki 9.satırdan itibaren aşağı doğru eklesin istemiştim

en son eklediğim excelde C9 hücresinden başlıyor yaptım ancak Text ilk satırdan itibaren alması lazım Texte de 9.satırdan itibaren aldığını ilk 8 kaydımın excelle aktarılmadığını fark ettim fark ettim

Aşağıdaki kodun Text den alma şekli doğru ancak Ecel dosyasının 1. satırı C1 değil C9 dan itibaren başlasın istiyorum

Kusura bakmayın hocam
C9 dan itibaren ayarlarsanız sevinirim


Sub ZCD_28_VERİ_AKTAR()
Dim i As Long, deg As String, sat As Long, deg2, k As Byte, dosya
Range("C9:ER2000").ClearContents
ChDir (ThisWorkbook.Path)
dosya = Application.GetOpenFilename(filefilter:="Metin dosyaları(*.txt),(*.txt)", Title:="Bir metin dosyası seçiniz.")
If dosya = False Then Exit Sub
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
Open dosya For Input As #1
Do While Not EOF(1)
Line Input #1, Kayıt
Satır = Satır + 1
Cells(Satır, 3) = Mid(Kayıt, 1, 6)
Cells(Satır, 4) = Mid(Kayıt, 8, 6)
Cells(Satır, 5) = Convert(Mid(Kayıt, 15, 11))
Cells(Satır, 6) = Convert(Mid(Kayıt, 27, 11))
Cells(Satır, 7) = Convert(Mid(Kayıt, 39, 1))
Cells(Satır, 8).NumberFormat = "@"
Cells(Satır, 8) = Mid(Kayıt, 41, 2)

Loop
Close #1
Cells.EntireColumn.AutoFit
End Sub

Function Convert(Veri As String)
Veri = Replace(Veri, Chr(154), "Ü")
Veri = Replace(Veri, Chr(166), "Ğ")
Veri = Replace(Veri, Chr(158), "Ş")
Veri = Replace(Veri, Chr(128), "Ç")
Veri = Replace(Veri, Chr(153), "Ö")
Veri = Replace(Veri, Chr(152), "İ")
Convert = Replace(Veri, Chr(15), "")
End Function
 
Son düzenleme:
arkadaşlar
yukarıdaki textden veri alma makrosunu
Exel in 9. satırından başlayacak şekilde düzenleye bilir misiniz
 
eyvallah hocam
şimdi tam oldu
ama öncekindende birşey öğrendim en azından
teşekkür ediyorum eline sağlık :)
 
Geri
Üst