VBA kodu hk

[Korhan Ayhan]

Dosyanızda son paylaştığım kodu göremiyorum...

 

[üveyin]

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

 

[Korhan Ayhan]

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

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.

 

[üveyin]

Korhan bey dogrudur ben anlatamamış olabilir. kusura bakmayın hakınızı helal edin emeğiniz için çok tşk ederim

 

[Korhan Ayhan]

#9 nolu mesajımdaki kodu revize ettim. Tekrar deneyiniz.

 

[üveyin]

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.

 

[Korhan Ayhan]

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.

 

[üveyin]

Korhan bey, inşallah bu liste olmuştur. başka anlatacağım bir yöntem bulamadım listemin üzerinde anlatmaya çalıştım.

 

[Korhan Ayhan]

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.

 

[üveyin]

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.

 

[Korhan Ayhan]

#9 nolu mesajımda ki kodu revie ettim. Tekrar deneyiniz.

 

[üveyin]

çok tşk ederim istediğim tam böyle bir kod elinize kolunuza sağlık

 

[üveyin]

Deneyiniz.

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

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

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

 

[Korhan Ayhan]

Denemekten zarar gelmez.

 

[üveyin]

denedim ama başarılı olamadım. (

 

[sevenvironment]

Denemekten zarar gelmez.

" & Range("S" & i).Value & " , kod içerisinde aldım. Benim sormak istediğim, neden başa ve sona & bu karakteri koyuyoruz?

 

[Korhan Ayhan]

& bu sembol birleştirme işlemi için kullanılmaktadır. Görevi budur.

 

[sevenvironment]

& bu sembol birleştirme işlemi için kullanılmaktadır. Görevi budur.

anladım, öncesinde ve sonrasında gelecek olan yazı veya sayıyı , range den gelen veri ile birleştiriyor.