Bİr SÜtÜndan AyriŞtirma (+ Ve -)

[Musa Batur]

Bİr Sütundan Ayriştırma (+ Ve -)

Bİr Sütundan Ayristirma (+ Ve -) Bulunan Değerleri Borç Alacak Olarak Ayri Ayri Sutunlara Ayriştirmak.

1 -Örnegİn Ekdekİ Lİstedekİ D SÜtunu - Ve + Karakterlere GÖre Yandaki Borç Sütununa Ve Alacak Sütununa Ayirmak itiyoruz

2 - A sütunu hariç diğer satırları altını bir satır acıp kopyalamak istiyorum.

3 - Gün degisiminde madde no koymak istiyorum

4 - Aslında her satırın altına A sütunundaki banka hesap numarası hariç olarak aynısını kopyalamak istiyoruz ve + F sutununa eksiler G sütünu olarak yapmak istiyorum.

Ekli dosyada üste orijinal kısmı alta olması gereken inçelerseniz sevinirim

Saygılarımla,

Teşekkürler

Saygilarimla

 

[uzmanamele]

merhaba
D2 hücresine; =EĞER(C2>0;C2;0)
E2 hücresine; =EĞER(C2>0;0;C2)
formüllerini yazıp alttaki hücrelere kopyalayın

 

[Necdet]

Merhaba

Aşağıdaki kodları bir modüle ekleyiniz.

Sub Duzenle()
Application.ScreenUpdating = False
For i = 2 To [C65536].End(3).Row
    If Cells(i, "C") < 0 Then
        Cells(i, "D") = Cells(i, "C") * -1
        Cells(i, "C").ClearContents
    End If
Next i
End Sub

 

[Musa Batur]

Necdet Bey dosyada değişik yaptım her satırın altına kopyalayıp ayrıca b sütununa kolan açtım ve orayada her tarih değiştiginde madde no versin şimdiden teşekkür ederim
Musa BATUR

 

[Necdet]

Merhaba,

Aşağıdaki kodları dener misiniz?

Sub Duzenle()
Dim Tarih As Date
Application.ScreenUpdating = False
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Columns("B:B").Select
    Selection.NumberFormat = "0"
    
    [B1] = "No"
    [F1] = ""
Son = [A65536].End(3).Row * 2 - 1
For i = 2 To Son Step 2
    If Cells(i, "D") < 0 Then Cells(i, "D") = Cells(i, "D") * -1
    Cells(i, "E") = Cells(i, "D")
    Rows(i).Select
    Selection.Copy
    Selection.Insert Shift:=xlDown
Next i
For i = 2 To [A65536].End(3).Row
    If Cells(i, "A") <> Tarih Then
       No = No + 1
       Tarih = Cells(i, "A")
    End If
    
    Cells(i, "B") = No
    j = i Mod 2
    If j = 0 Then
        Cells(i, "E").ClearContents
    Else
        Cells(i, "D").ClearContents
    End If
Next i
[A1].Activate
MsgBox "İşlem Tamamdır...."
End Sub

 

[Musa Batur]

1 -Örnegİn Ekdekİ Lİstedekİ D SÜtunu - Ve + Karakterlere GÖre Yandaki Borç Sütununa Ve Alacak Sütununa Ayirmak itiyoruz

2 - A sütunu hariç diğer satırları altını bir satır acıp kopyalamak istiyorum.

3 - Gün degisiminde madde no koymak istiyorum

4 - Aslında her satırın altına A sütunundaki banka hesap numarası hariç olarak aynısını kopyalamak istiyoruz ve + F sutununa eksiler G sütünu olarak yapmak istiyorum.

Ekli dosyada üste orijinal kısmı alta olması gereken inçelerseniz sevinirim

 

[Musa Batur]

Necdet Bey bir sorun daha çıktı A sutunu açmak zorunda kaldım muhasebe banka hesap no yazmam gerekiyordu bir satır kopyaladıgında a sutununu boş bırakması gerekiyor. sonra ben 120 alıcılar 320 satıcılar 770 masraf gibi hesap kodu yazacağım yeniden ek liste gönderdim ilgilenirsen sevinirim.

saygılarımla

Musa Batur

 

[Necdet]

Merhaba,

Benim kafam karıştı hangi dosyayı baz olarak alıp üzerinde işlem yapacağız.

Tek bir dosya ekleyip olan bir sayfada, olması gerekeni de başka bir sayfada örneklerseniz sonuca ulaşmak daha kolay olur.

Bakalım dosyayı tutturabildimmi, incelyiniz.

Sub Duzenle()
Dim Tarih As Date
Dim No As Integer
Application.ScreenUpdating = False
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Selection.NumberFormat = "0"
[C1] = "Madde No"
'-------------- Boş Satır Açar -----------------------
For i = [A65536].End(3).Row To 3 Step -1
    Rows(i).Insert Shift:=xlDown
Next i
'-------------- Boş Satır Açma Sonu ------------------
'-------------- Boş Satırları Doldurma ---------------
For i = 2 To [A65536].End(3).Row Step 2
    If Cells(i, "B") <> Tarih Then
        No = No + 1
        Tarih = Cells(i, "B")
    End If
    Cells(i, "C") = No
    Cells(i + 1, "C") = No
    Cells(i + 1, "B") = Cells(i, "B")
    Cells(i + 1, "D") = Cells(i, "D")
    If Cells(i, "E") < 0 Then
       Cells(i, "G") = Cells(i, "E") * -1
       Cells(i + 1, "F") = Cells(i, "E") * -1
    Else
       Cells(i, "F") = Cells(i, "E")
       Cells(i + 1, "G") = Cells(i, "E")
    End If
Next i
'-------------- Boş Satırları Doldurma Sonu ----------
[H1].Activate
MsgBox "Düzenleme Bitmiştir....", vbOKOnly, "[URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]  n.y."
End Sub

 

[Musa Batur]

Necdet bey size çok teşekkür ederim. Allah Razı olsun

 

[Necdet]

Rica ederim Musa Bey,

Güle güle kullanınız. Mutlu yıllar.

 

[Musa Batur]

Merhaba,

Aşağıdaki kodları dener misiniz?

Sub Duzenle()
Dim Tarih As Date
Application.ScreenUpdating = False
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Columns("B:B").Select
    Selection.NumberFormat = "0"
    
    [B1] = "No"
    [F1] = ""
Son = [A65536].End(3).Row * 2 - 1
For i = 2 To Son Step 2
    If Cells(i, "D") < 0 Then Cells(i, "D") = Cells(i, "D") * -1
    Cells(i, "E") = Cells(i, "D")
    Rows(i).Select
    Selection.Copy
    Selection.Insert Shift:=xlDown
Next i
For i = 2 To [A65536].End(3).Row
    If Cells(i, "A") <> Tarih Then
       No = No + 1
       Tarih = Cells(i, "A")
    End If
    
    Cells(i, "B") = No
    j = i Mod 2
    If j = 0 Then
        Cells(i, "E").ClearContents
    Else
        Cells(i, "D").ClearContents
    End If
Next i
[A1].Activate
MsgBox "İşlem Tamamdır...."
End Sub

Banka Ekst. Muhasebeye Aktarmak
Diye bir dosya yükledim daha önce siz makro yazmıştınız acıklamaları dosyada bulabilirsiz düzeltirsen sevinirim
Teşekkürler
Musa Batur