1903emre34@gmail.com
Altın Üye
- Katılım
- 29 Mayıs 2016
- Mesajlar
- 906
- Excel Vers. ve Dili
- Microsoft Excel 2013 Türkçe
- Altın Üyelik Bitiş Tarihi
- 06-06-2027
Merhaba,
Ara toplam 3 ile başlayan hesap kodları sağdan üç haneli hesap kodları, sayfa2 de ana hesap bölümün altına ve kümüle bakiye altında yer alan tutarları sayfa2 de yanına aktarılması için kod oluşturabilir miyiz (istenen sayfa2 de yapılmıştır)
Forumda aşağıdaki kod buldum, çalışmadı
Sub aratoplamlar()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
son1 = s1.Cells(Rows.Count, "A").End(3).Row
For i = 3 To son1
If Left(s1.Cells(i, "A"), 10) = "Ara toplam" Then
eski = WorksheetFunction.Max(6, s2.Cells(Rows.Count, "C").End(3).Row)
If WorksheetFunction.CountIf(s2.Range("C6:C" & eski), Right(s1.Cells(i, "A"), 3)) > 0 Then
sat = WorksheetFunction.Match(Right(s1.Cells(i, "A"), 3) * 1, s2.Range("C6:C" & eski), 0) + 5
Else
sat = eski + 1
If s2.[C6] = "" Then sat = 6
s2.Cells(sat, "C") = Right(s1.Cells(i, "A"), 3)
End If
If s1.Cells(i, "J") > 0 Then
s2.Cells(sat, "D") = s1.Cells(i, "J")
ElseIf s1.Cells(i, "J") < 0 Then
s2.Cells(sat, "E") = s1.Cells(i, "J") * (-1)
End If
End If
Next
End Sub
Ara toplam 3 ile başlayan hesap kodları sağdan üç haneli hesap kodları, sayfa2 de ana hesap bölümün altına ve kümüle bakiye altında yer alan tutarları sayfa2 de yanına aktarılması için kod oluşturabilir miyiz (istenen sayfa2 de yapılmıştır)
Forumda aşağıdaki kod buldum, çalışmadı
Sub aratoplamlar()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
son1 = s1.Cells(Rows.Count, "A").End(3).Row
For i = 3 To son1
If Left(s1.Cells(i, "A"), 10) = "Ara toplam" Then
eski = WorksheetFunction.Max(6, s2.Cells(Rows.Count, "C").End(3).Row)
If WorksheetFunction.CountIf(s2.Range("C6:C" & eski), Right(s1.Cells(i, "A"), 3)) > 0 Then
sat = WorksheetFunction.Match(Right(s1.Cells(i, "A"), 3) * 1, s2.Range("C6:C" & eski), 0) + 5
Else
sat = eski + 1
If s2.[C6] = "" Then sat = 6
s2.Cells(sat, "C") = Right(s1.Cells(i, "A"), 3)
End If
If s1.Cells(i, "J") > 0 Then
s2.Cells(sat, "D") = s1.Cells(i, "J")
ElseIf s1.Cells(i, "J") < 0 Then
s2.Cells(sat, "E") = s1.Cells(i, "J") * (-1)
End If
End If
Next
End Sub
Ekli dosyalar
-
13.2 KB Görüntüleme: 5