• DİKKAT

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

kodda değişiklik

  • 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;

bir bölümünü göndermiş olduğum bu kodda; bir noktada takıldım..; ( bu txt dosyasından veri alan bir kod.)

Kod:
Private Sub cvataekle_Click()
Dim Str5 As Long, say As Byte
Dim Str6 As Long, say1 As Byte
Dim Dosya, Veri_1, Veri_2, Veri_3, cvtadt, deg2, sat, stir, i, f, a
cvtadt = Sheets("KOLON").Range("G53").End(3).Row + 0
[COLOR="DarkRed"]stir = Sheets("KOLON").Range("G53").End(3).Row + 5[/COLOR]


Dosya = Application.GetOpenFilename("Civata dosyaları(*.xsr),*.xsr", , "Lütfen BOLT LIST dosyasını seçiniz...")
If Dosya = False Then
MsgBox "İşleminiz iptal edilmiştir."
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), " ")
                Veri_3 = Split(Trim(Veri_1), " ")
                cvtadt = cvtadt + 1
                [B][COLOR="Blue"]Cells(cvtadt, 9) = Veri_2(UBound(Veri_2)) * 1 'SÜTUN[/COLOR][/B]
                stir = stir + 1
                [B][COLOR="Red"]Cells(stir, 9) = Veri_3(UBound(Veri_3)) * 2[/COLOR][/B] 'SÜTUN

***** şeklinde kod devam ediyor.. başka işlemlere...
şimdi kırmızı ile belirttiğim satırda hücre atlaması oluyor.. bunu veri_2 den sonra devam edecek şekilde nasıl ayarlayabilirim .?
 
Son düzenleme:
merhaba arkadaşlar;

bir bölümünü göndermiş olduğum bu kodda; bir noktada takıldım..; ( bu txt dosyasından veri alan bir kod.)

Kod:
Private Sub cvataekle_Click()
Dim Str5 As Long, say As Byte
Dim Str6 As Long, say1 As Byte
Dim Dosya, Veri_1, Veri_2, Veri_3, cvtadt, deg2, sat, stir, i, f, a
cvtadt = Sheets("KOLON").Range("G53").End(3).Row + 0
stir = Sheets("KOLON").Range("G53").End(3).Row + 5


Dosya = Application.GetOpenFilename("Civata dosyaları(*.xsr),*.xsr", , "Lütfen BOLT LIST dosyasını seçiniz...")
If Dosya = False Then
MsgBox "İşleminiz iptal edilmiştir."
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), " ")
                Veri_3 = Split(Trim(Veri_1), " ")
                cvtadt = cvtadt + 1
                [B][COLOR="Blue"]Cells(cvtadt, 9) = Veri_2(UBound(Veri_2)) * 1 'SÜTUN[/COLOR][/B]
                stir = stir + 1
                [B][COLOR="Red"]Cells(stir, 9) = Veri_3(UBound(Veri_3)) * 2[/COLOR][/B] 'SÜTUN

***** şeklinde kod devam ediyor.. başka işlemlere...
şimdi kırmızı ile belirttiğim satırda hücre atlaması oluyor.. bunu veri_2 den sonra devam edecek şekilde nasıl ayarlayabilirim .?

Merhaba tam olarak olaya vakıf değilim fakat
kırmızı ile belirttiğiniz koddan sonraya ekleyip deneyiniz
 
Örnek dosya yok
bu yüzden yapılması istenen net değil
örn:
niçin
değil
"g53" ten sonra 5 'er mi atlaması gerekiyor?

Merhaba hocam. zaten sıkıntı o noktada.. yani +5 kısmında,, hayır 5 atlaması gerekmiyor, 5 deneme için yazmıştım.. sanırım 0 olması gerekiyor... bir önceki satır o kısımdan başlıyor,, 5 kadar olan kısımda veri var. daha sonra aynı değerler 2 ile çarpılarak eklenmesi gerekiyor..

iki tane örnek dosya ekliyorum. burada aldığım değerler; quantity kısmımdaki rakamlar. bunları sıra ile alacak.. tabloya.. akabinde yine aynı sıralamada 2 ile çarparak alacak.. bunu yapmaya çalışıyorum..
Ekli dosyayı görüntüle bolt.rar
 
Son düzenleme:
Merhaba hocam. zaten sıkıntı o noktada.. yani +5 kısmında,, hayır 5 atlaması gerekmiyor, 5 deneme için yazmıştım.. sanırım 0 olması gerekiyor... bir önceki satır o kısımdan başlıyor,, 5 kadar olan kısımda veri var. daha sonra aynı değerler 2 ile çarpılarak eklenmesi gerekiyor..

iki tane örnek dosya ekliyorum. burada aldığım değerler; quantity kısmımdaki rakamlar. bunları sıra ile alacak.. tabloya.. akabinde yine aynı sıralamada 2 ile çarparak alacak.. bunu yapmaya çalışıyorum..
Ekli dosyayı görüntüle 140408

Merhaba
Ekli dosyanızı açamadım
malesef yardımcı olamıyacağım
 
Son düzenleme:
Geri
Üst