txt veri almak ve 2 ile çarpmak

[k0081]

merhaba arkadaşlar;

Ekli dosyayı görüntüle civata_listesi.txt

ekte göndermiş olduğum dosyada;

I5 hücresinden itibaren,

160
72
188
96
320
144
376
192

şeklinde yazdırabilirmiyim..? kırmızı ile belirttiğim değerler text dosyasındaki sayıların 2 ile çarpılmış halidir...

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

 

[halit3]

merhaba arkadaşlar;

Ekli dosyayı görüntüle 140603

ekte göndermiş olduğum dosyada;

I5 hücresinden itibaren,

160
72
188
96
320
144
376
192

şeklinde yazdırabilirmiyim..? kırmızı ile belirttiğim değerler text dosyasındaki sayıların 2 ile çarpılmış halidir...

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

Aşağıdaki linkdeki benzer bir sorunuza daha önceden cevap verilmiş

http://www.excel.web.tr/f48/degeri-iki-ile-carparak-almak-t119567.html


kodun kırmızı yerini değştirin

Cells(Satir, [COLOR=red]1[/COLOR]) = Veri_2(UBound(Veri_2)) * 2

Cells(Satir, [COLOR=red]9[/COLOR]) = Veri_2(UBound(Veri_2)) * 2

birde aşağıdaki bölümden sonra

Dim Dosya, Veri_1, Veri_2, Satir

bunu ekleyin

Satir = 4

 

[k0081]

hocam; daha önceki cevap sadece bir kısmı karşılıyor.. 2 ile çarpıyor.. doğrudur.. ama benim şimdiki sorum da öncelikle ilk değerleri alıp hücreye yerleştirecek akabinde 2 ile çarparak devam edecek hocam..

 

[halit3]

Başka konuya cevaben yazacaktım bu mesaj yanlış olduğu için sildim.

 

[halit3]

kod:

Option Explicit
Sub Txt_Dosyasindan_Veri_Al()
Dim Dosya, Veri_1, Veri_2, Satir, [COLOR=red]sat, i
ReDim deg(5000)
Satir = 4
[/COLOR]Dosya = Application.GetOpenFilename("Text Files (*.txt),*.txt", , "Lütfen veri almak istediğiniz txt dosyasını seçiniz...")
If Dosya = False Then
MsgBox "İşleminiz iptal edilmiştir.", vbExclamation
Exit Sub
End If
Open Dosya For Input As #1
Do While Not EOF(1)
Line Input #1, Veri_1
If IsNumeric(Left(Trim(Veri_1), 1)) Then
Veri_2 = Split(Trim(Veri_1), " ")
Satir = Satir + 1
Cells(Satir, [COLOR=red]9[/COLOR]) = Veri_2(UBound(Veri_2)) [COLOR=red]'* 2
[/COLOR][COLOR=red]sat = sat + 1
deg(sat) = Cells(Satir, 9)
[/COLOR]End If
Loop
Close #1
[COLOR=red]If sat > 0 Then
For i = 1 To sat
Satir = Satir + 1
Cells(Satir, 9) = deg(i) * 2
Next
End If
[/COLOR]Cells.EntireColumn.AutoFit
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[k0081]

halit3;

hocam çok teşekkürler tamamdır.. elinize yüreğinize sağlık,, büyüksünüz.. saygılar..

 

[halit3]

halit3;

hocam çok teşekkürler tamamdır.. elinize yüreğinize sağlık,, büyüksünüz.. saygılar..

Kodu ben yazmadım yukarıdaki mesajımdaki linkden aldım ve kırmızı yerleri ekledim.

 

[k0081]

Kodu ben yazmadım yukarıdaki mesajımdaki linkden aldım ve kırmızı yerleri ekledim.

hocam banada lazım olan kısımlar, kırmızı ile belirttiğiniz yerlerdi.. çok teşekkürler..