- Katılım
- 17 Haziran 2008
- Mesajlar
- 1,874
- Excel Vers. ve Dili
- Microsoft Ofis Profesyonel 2019 x64 TR
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
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
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
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