• DİKKAT

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

VBA kodu hk

Dosyanızda son paylaştığım kodu göremiyorum...
 
KESIM-270422-143430 bu listadeki 3 & 4 satırda olması gereken deger mm dosyasındaki (P) (S) (U) sütünundaki deger olmalı, aşağıdaki kod ile (G) (J) (L) sütünundaki değer geliyor.

Private Sub CommandButton1_Click()
cevap = MsgBox("Dosya farklı kaydedilecek emin misiniz ?", vbYesNo)
If cevap = vbYes Then

Dim i As Integer, j As Integer, myrng As Range
Dim filename As String, fNum As Byte, Baslik As String

fNum = FreeFile

filename = ThisWorkbook.Path & "\KESIM-" & Format(Now, "ddmmyy-hhmmss") & ".csv"

Open filename For Output As fNum
Baslik = Join(Application.Transpose(Application.Transpose(Sheets("Sayfa1").Range("K1:V1").Value)), ";")
Print #1, Baslik
Baslik = Join(Application.Transpose(Application.Transpose(Sheets("Sayfa1").Range("K2:V2").Value)), ";")
Print #1, Baslik

For i = 11 To 1000
If Range("B" & i).Value <> "" Then
If Range("BA" & i).Value <> "" And Range("BE" & i).Value <> "" Then
ifade = ifade & Range("G" & i).Value & ";" & Range("J" & i).Value & ";" & Range("L" & i).Value & ";"
Else
ifade = ifade & Range("P" & i).Value & ";" & Range("S" & i).Value & ";" & Range("U" & i).Value & ";"
End If
ifade = ifade & Range("BU" & i).Value & ";" & Range("B" & i).Value & ";" & Range("AI" & i).Value & ";" & Range("AK" & i).Value & ";"
ifade = ifade & Range("AM" & i).Value & ";" & Range("AO" & i).Value & ";" & Range("BM" & i).Value

Print #1, ifade
ifade = ""
End If
Next i
Close #1

MsgBox ("Csv Dosya kaydedildi.")
End If
End Sub
 

Ekli dosyalar

Bu mesajınıza göre kodu yazmıştım. O zaman sanırım tam tersi olacak..

üveyin' Alıntı:
BA & BE boş ise (P) (S) (U) hücresindeki değerleri alması gerekiyor, eger BA & BE dolu ise (G) (J) (L) hücresindeki değerleri alması gerekiyor.
Genişletmek için tıkla ...
 
Korhan bey dogrudur ben anlatamamış olabilir. kusura bakmayın hakınızı helal edin emeğiniz için çok tşk ederim
 

Ekli dosyalar

#9 nolu mesajımdaki kodu revize ettim. Tekrar deneyiniz.
 
Korhan bey, ben konuyu tam anlatamadım, benim istediğim şöyle birsey yani kafamdaki kurgu aynı liste içinde iki çeşit ölçüm var birinde yüzey kaplaması oldugundan dolayı 10mm büyük olması için BA BE satırlarında veri yazılı olursa (G) (J) (L) satırındaki ölçüyü getirecek yine aynı listede BA BE satırları boş oldugunda (P) (S) (U) satırındaki ölçüyü getirecek böyle bir kurgu olacak bunu anlatamadım benim anlatmama istinaden yazdıgınız kodlarda bu istediğim şey olmuyor bende anlatamıyorum galiba kusura bakmayın çok özür diliyorum.
 
O zaman şöyle yapın.

Bu verilere göre görmek istediğim sonuç bu şeklinde örnek bir tablo oluşturun. Ona göre kodu düzenleyelim.
 
Korhan bey, inşallah bu liste olmuştur. başka anlatacağım bir yöntem bulamadım listemin üzerinde anlatmaya çalıştım.
 

Ekli dosyalar

Bu durumda ilk önerdiğim doğruymuş sonucunu çıkarıyorum.

Fakat paylaştığınız dosyada boş görünen hücreler aslında boş değilde sıfır yazıyor. Bu sebeple kod çalışmamış. Bu hücreler gerçekten boşmu olacak yoksa sıfır mı yazacak? Kodu ona göre revize edelim.

Ek olarak sizin tablonuz 10. satırdan başlıyor. Fakat kod içindeki 11. satırdan sorguya başlıyor. Tablonuzda 10. satıra veri girerseniz kod bunu görmeyecektir.
 
evet bende dikkat etmedim. dosyadın tümünde yazılan kodlarda dolayı sıfır atıyor o hücrelere sıfır olacak şekilde ayarlayalım, 10. satır boş olarak düşünün.
 
#9 nolu mesajımda ki kodu revie ettim. Tekrar deneyiniz.
 
çok tşk ederim istediğim tam böyle bir kod elinize kolunuza sağlık
 
Korhan Ayhan' Alıntı:
Deneyiniz.

Sayfa1'de K1:V2 aralığına başlık verilerinizi kopyaladım.

C++: 
Private Sub CommandButton1_Click()
    cevap = MsgBox("Dosya farklı kaydedilecek emin misiniz ?", vbYesNo)
    If cevap = vbYes Then

        Dim i As Integer, j As Integer, myrng As Range
        Dim filename As String, fNum As Byte, Baslik As String

        fNum = FreeFile
   
        filename = ThisWorkbook.Path & "\KESIM-" & Format(Now, "ddmmyy-hhmmss") & ".csv"
   
        Open filename For Output As fNum
            Baslik = Join(Application.Transpose(Application.Transpose(Sheets("Sayfa1").Range("K1:V1").Value)), ";")
            Print #1, Baslik
            Baslik = Join(Application.Transpose(Application.Transpose(Sheets("Sayfa1").Range("K2:V2").Value)), ";")
            Print #1, Baslik
          
            For i = 11 To 1000
                If Range("B" & i).Value <> "" Then
                    If Range("BA" & i).Value <> 0 And Range("BE" & i).Value <> 0 Then
                        ifade = ifade & Range("G" & i).Value & ";" & Range("J" & i).Value & ";" & Range("L" & i).Value & ";"
                    Else
                        ifade = ifade & Range("P" & i).Value & ";" & Range("S" & i).Value & ";" & Range("U" & i).Value & ";"
                    End If
                    ifade = ifade & Range("BU" & i).Value & ";" & Range("B" & i).Value & ";" & Range("AI" & i).Value & ";" & Range("AK" & i).Value & ";"
                    ifade = ifade & Range("AM" & i).Value & ";" & Range("AO" & i).Value & ";" & Range("BM" & i).Value
               
                    Print #1, ifade
                    ifade = ""
                End If
            Next i
        Close #1
   
        MsgBox ("Csv Dosya kaydedildi.")
    End If
End Sub
Genişletmek için tıkla ...


bu kod içine başka satır ihtiyaçlarım oldu bunu nasıl yapmalıyım ? ifade = ifade & Range("yeni satır" & i).Value & ";" & Range("yeni satır" & i).Value & ";" & Range("yeni satır" & i).Value
 
& bu sembol birleştirme işlemi için kullanılmaktadır. Görevi budur.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst