• DİKKAT

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

D4 hücresindeki veriye göre TXT den..

  • Konbuyu başlatan Konbuyu başlatan k0081
  • Başlangıç tarihi Başlangıç tarihi
Katılım
17 Haziran 2008
Mesajlar
1,874
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Merhaba arkadaşlar;

D4 hücresindeki veriye göre txt dosyasından istenilen değeri nasıl çekebiliriz..?

örnek dosyadaki 15,5 gibi.. bir de burda . değilde virgüllü olarak çekmek istiyorum..

yardımcı arkadaşa şimdiden teşekkürler..
 

Ekli dosyalar

Merhaba,
sayfadaki butonun koduna kopyalayıp deneyiniz.
İyi akşamlar.

Kod:
Private Sub CommandButton1_Click()
    Dim dosya As String, d As String
    Dim i As Integer
    
    On Error Resume Next
    
    dosya = Application.GetOpenFilename( _
            "Text Dosyaları (*.txt) (*.txt), *.txt", 1, _
            "::....... http://www.excel.web.tr......::")

    If dosya = "False" Then Exit Sub
    Open dosya For Input As #1
        Do While Not EOF(1)

            Line Input #1, d
            If InStr(1, d, Range("d4"), vbTextCompare) > 0 Then

                     x = Split(d, " ")
                    For i = 0 To UBound(x)
                        If x(i) = "kg" Then
                        Range("e4") = Replace(x(i - 1), ".", ",", 1)
                        Exit Do
                        End If
                    Next i
            End If
        Loop
    Close #1
    
End Sub
 
Merhaba,

Alternatif olsun.

Kod:
Private Sub CommandButton1_Click()
    On Error GoTo Son
    
    Dim Dosya_Uzunluk   As Integer, _
        Yol             As String, _
        DosyaAdi        As String, _
        Deger           As String, _
        Veri            As String, _
        a
        
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = False
        .Show
            a = Split(StrReverse(.SelectedItems(1)), "\")
            Dosya_Uzunluk = Len(Trim$(a(0)))
            Yol = Left(.SelectedItems(1), Len(.SelectedItems(1)) - Dosya_Uzunluk)
            DosyaAdi = Right(.SelectedItems(1), Dosya_Uzunluk)
    End With
    
    Range("E4").ClearContents
    
    Open Yol & DosyaAdi For Input As #1
    
    While Not EOF(1)
        Line Input #1, Veri
        
        Deger = Mid(Veri, 25, Len(Trim([D4])))
        If Deger = Trim([D4]) Then
            Range("E4") = Mid(Veri, 62, Len(Veri) - 63)
            Close #1
            Exit Sub
        End If
    Wend
    
    Close #1
Son:
End Sub
 

Ekli dosyalar

Merhaba,
sayfadaki butonun koduna kopyalayıp deneyiniz.
İyi akşamlar.

Kod:
Private Sub CommandButton1_Click()
    Dim dosya As String, d As String
    Dim i As Integer
    
    On Error Resume Next
    
    dosya = Application.GetOpenFilename( _
            "Text Dosyaları (*.txt) (*.txt), *.txt", 1, _
            "::....... http://www.excel.web.tr......::")

    If dosya = "False" Then Exit Sub
    Open dosya For Input As #1
        Do While Not EOF(1)

            Line Input #1, d
            If InStr(1, d, Range("d4"), vbTextCompare) > 0 Then

                     x = Split(d, " ")
                    For i = 0 To UBound(x)
                        If x(i) = "kg" Then
                        Range("e4") = Replace(x(i - 1), ".", ",", 1)
                        Exit Do
                        End If
                    Next i
            End If
        Loop
    Close #1
    
End Sub


çok teşekkürler hocam.. Eywallah..
 
Merhaba,

Alternatif olsun.

Kod:
Private Sub CommandButton1_Click()
    On Error GoTo Son
    
    Dim Dosya_Uzunluk   As Integer, _
        Yol             As String, _
        DosyaAdi        As String, _
        Deger           As String, _
        Veri            As String, _
        a
        
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = False
        .Show
            a = Split(StrReverse(.SelectedItems(1)), "\")
            Dosya_Uzunluk = Len(Trim$(a(0)))
            Yol = Left(.SelectedItems(1), Len(.SelectedItems(1)) - Dosya_Uzunluk)
            DosyaAdi = Right(.SelectedItems(1), Dosya_Uzunluk)
    End With
    
    Range("E4").ClearContents
    
    Open Yol & DosyaAdi For Input As #1
    
    While Not EOF(1)
        Line Input #1, Veri
        
        Deger = Mid(Veri, 25, Len(Trim([D4])))
        If Deger = Trim([D4]) Then
            Range("E4") = Mid(Veri, 62, Len(Veri) - 63)
            Close #1
            Exit Sub
        End If
    Wend
    
    Close #1
Son:
End Sub

çok teşekkürler.. sağol hocam..
 
rica ederiz, sizler de sağolun.
 
Geri
Üst