txt dosyasını hücrelere yazdırma sorunu

[busraakrky]

Merhabalar
txt dosyalarımda başlıklarım stabil (TRAFO DEGERLERI,Trafonun Gucu vs..) fakat değerleri her dosyada farklı. bu dosyalardaki değerleri, başlıkların alt alta yazılı olduğu bi sayfadaki c ve d sütünlarına yazdırmak istiyorum bir buton ile. Koduaşağıdaki gibi yazdım fakat iki sütuna da ilk seçtiğim dosyadaki değer neyse onu yazıyor. Napmalıyım yardımcı olursanız çok sevinirim. Teşekkürler.

Butonun içindeki kod:

Dim myFile As String, text As String, textline As String, baslik As Integer, posLat As Integer, posLong As Integer, A As Integer, fa As Integer,
myFile = Application.GetOpenFilename()
Open myFile For Input As #1
Do Until EOF(1)
Line Input #1, textline
text = text & textline
Loop
Close #1
baslik = InStr(text, "TRAFO DEGERLERI")
posLat = InStr(text, "Trafonun Gucu:")
posLong = InStr(text, "Frekans:")
A = InStr(text, "Baglanti Grubu:")
fa = InStr(text, "FAZ Sayisi:")

Range("C7").Value = Mid(text, baslik + 20, 15)
Range("C8").Value = Mid(text, posLat + 14, 8)
Range("C9").Value = Mid(text, posLong + 8, 10)
Range("C10").Value = Mid(text, A + 15, 1)
Range("C11").Value = Mid(text, fa + 11, 5)
NewFile = Application.GetOpenFilename()
Open NewFile For Input As #1
Do Until EOF(1)
Line Input #1, textline
text = text & textline
Loop
Close #1
baslik = InStr(text, "TRAFO DEGERLERI")
posLat = InStr(text, "Trafonun Gucu:")
posLong = InStr(text, "Frekans:")
A = InStr(text, "Baglanti Grubu:")
fa = InStr(text, "FAZ Sayisi:")

Range("D7").Value = Mid(text, baslik + 20, 15)
Range("D8").Value = Mid(text, posLat + 14, 8)
Range("D9").Value = Mid(text, posLong + 8, 10)
Range("D10").Value = Mid(text, A + 15, 1)
Range("D11").Value = Mid(text, fa + 11, 5)
End Sub

 

[Haluk]

Text dosyalarından örnek eklerseniz, duruma bakalım ....

.

 

[busraakrky]

txt dosyasını yüklemeyi beceremedim fakat dosyaların içinde kısaca böyle yazıyor değerleri değişiyor sadece

TRAFO DEGERLERI (AG-YG:CU)
Trafonun Gucu: 50 kVA
Frekans: 50 HZ
Baglanti Grubu:Y Z
FAZ Sayisi: 3 FAZ

 

[Haluk]

Google Drive gibi bir yere yükleyin ... ya da "Altın Üye" olun.

.

 

[Haluk]

Neyse; siz şunu kullanın ....

Sub Test()
    Dim myFile As String, text As String, textline As String
    Dim baslik As Integer, posLat As Integer, posLong As Integer, A As Integer, fa As Integer
    
    myFile = Application.GetOpenFilename()
    
    Open myFile For Input As #1
        Do Until EOF(1)
            Line Input #1, textline
            text = text & textline
        Loop
    Close #1
    
    baslik = InStr(text, "TRAFO DEGERLERI")
    posLat = InStr(text, "Trafonun Gucu:")
    posLong = InStr(text, "Frekans:")
    A = InStr(text, "Baglanti Grubu:")
    fa = InStr(text, "FAZ Sayisi:")
    
    Range("C7").Value = Mid(text, baslik + 20, 15)
    Range("C8").Value = Mid(text, posLat + 14, 8)
    Range("C9").Value = Mid(text, posLong + 8, 10)
    Range("C10").Value = Mid(text, A + 15, 1)
    Range("C11").Value = Mid(text, fa + 11, 5)
    
    NewFile = Application.GetOpenFilename()
    text = ""
    
    Open NewFile For Input As #1
        Do Until EOF(1)
            Line Input #1, textline
            text = text & textline
        Loop
    Close #1
    
    baslik = InStr(text, "TRAFO DEGERLERI")
    posLat = InStr(text, "Trafonun Gucu:")
    posLong = InStr(text, "Frekans:")
    A = InStr(text, "Baglanti Grubu:")
    fa = InStr(text, "FAZ Sayisi:")
    
    Range("D7").Value = Mid(text, baslik + 20, 15)
    Range("D8").Value = Mid(text, posLat + 14, 8)
    Range("D9").Value = Mid(text, posLong + 8, 10)
    Range("D10").Value = Mid(text, A + 15, 1)
    Range("D11").Value = Mid(text, fa + 11, 5)
End Sub

 

[busraakrky]

https://drive.google.com/file/d/1tqGlJOxJIsDd9tVIcCF05YgpTs5F21kl/view?usp=sharing

Yazdığınız kodu denedim ama olmadı linkte txt dosyalar ve excell dosyası da var projeleri karşılaştır butonunda bu sorunu yaşıyorum. Bakabilirseniz sevinirim.

 

[Haluk]

Kodu revize etmiştim, bir kere daha bakın .....

.

 

[busraakrky]

Sanırım oldu çok teşekkürler