koşullu biçimlendirmeyi aktarma

O

okancicek

Altın Üye
Katılım
22 Nisan 2012
Mesajlar
40
Excel Vers. ve Dili
2010 docx
Altın Üyelik Bitiş Tarihi
24.08.2024
merhabalar. excelde koşullu biçimlendirme yapmayı becerdim ama koşullu biçimlesirme olanı diğer sayfaya nasıl aktarırım.eklediğim dosyada kırmızı olan firmadan alınacak para olarak belirledim yesil olan ise verilecek İade olarak belirledim. FİRMA İSMİNE GORE KRİTER alınması gerekiyor excell icinde acıklama olarak yazdım umarım derdimi anlatabilmişimdir
 

Ekli dosyalar

O

okancicek

Altın Üye
Katılım
22 Nisan 2012
Mesajlar
40
Excel Vers. ve Dili
2010 docx
Altın Üyelik Bitiş Tarihi
24.08.2024
okancicek' Alıntı:
merhabalar. excelde koşullu biçimlendirme yapmayı becerdim ama koşullu biçimlesirme olanı diğer sayfaya nasıl aktarırım.eklediğim dosyada kırmızı olan firmadan alınacak para olarak belirledim yesil olan ise verilecek İade olarak belirledim. FİRMA İSMİNE GORE KRİTER alınması gerekiyor excell icinde acıklama olarak yazdım umarım derdimi anlatabilmişimdir
Genişletmek için tıkla ...
yardımcı olabilecek varmı
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Alınacak ve verilecek sayfalarındaki fatura no ve tarih sütunlarının bir önemi var mı? Varsa hangi kaydın bilgileri yazılacak? Yoksa neden sayfada kullanıyorsunuz?
 
O

okancicek

Altın Üye
Katılım
22 Nisan 2012
Mesajlar
40
Excel Vers. ve Dili
2010 docx
Altın Üyelik Bitiş Tarihi
24.08.2024
YUSUF44' Alıntı:
Alınacak ve verilecek sayfalarındaki fatura no ve tarih sütunlarının bir önemi var mı? Varsa hangi kaydın bilgileri yazılacak? Yoksa neden sayfada kullanıyorsunuz?
Genişletmek için tıkla ...
fatura no ve tarih sütunlarının önemi yok FİRMA/KİŞİ İSMLERİ ve FİRMA/KİŞİ BORÇU yansısın yeterlidir tesekkürler.(Okulda ürün satım kücük bir takip excell hazırlıyoruz. hep manuel toplama falan yapıyorlar bunla bir nebze yükü azaltır diye buna başvurdum )
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki makroyu deneyiniz:

PHP: 
Sub aktar()
Set s1 = Sheets("Liste")
Set s2 = Sheets("alınacak para")
Set s3 = Sheets("verilecek para")
son = s1.Cells(Rows.Count, "C").End(3).Row
eski2 = s2.Cells(Rows.Count, "C").End(3).Row
eski3 = s3.Cells(Rows.Count, "C").End(3).Row
Application.ScreenUpdating = True
If eski2 > 1 Then s2.Range("A2:G" & eski2).ClearContents
If eski3 > 1 Then s3.Range("A2:G" & eski3).ClearContents

Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no;imex=1"""

sorgu = "select distinct F2,F3,F4 from [Liste$A3:I" & son & "] where F3 is not null"
Set rs = con.Execute(sorgu)
s2.[B2].CopyFromRecordset rs
sorgu = "select distinct F2,F3,F4 from [Liste$A3:I" & son & "] where F3 is not null"
Set rs = con.Execute(sorgu)
s3.[B2].CopyFromRecordset rs
enson = s2.Cells(Rows.Count, "C").End(3).Row

For i = enson To 2 Step -1
    If WorksheetFunction.SumIf(s1.Range("C3:C" & son), s2.Cells(i, "C"), s1.Range("I3:I" & son)) > 0 Then
        s2.Cells(i, "G") = WorksheetFunction.SumIf(s1.Range("C3:C" & son), s2.Cells(i, "C"), s1.Range("I3:I" & son))
        s3.Rows(i).Delete
    ElseIf WorksheetFunction.SumIf(s1.Range("C3:C" & son), s3.Cells(i, "C"), s1.Range("I3:I" & son)) < 0 Then
        s3.Cells(i, "G") = WorksheetFunction.SumIf(s1.Range("C3:C" & son), s2.Cells(i, "C"), s1.Range("I3:I" & son)) * (-1)
        s2.Rows(i).Delete
    Else
        s2.Rows(i).Delete
        s3.Rows(i).Delete
    End If
Next
enson2 = s2.Cells(Rows.Count, "C").End(3).Row
If enson2 > 1 Then
    For j = 2 To enson2
        s2.Cells(j, "A") = j - 1
    Next
End If
enson3 = s3.Cells(Rows.Count, "C").End(3).Row
If enson3 > 1 Then
    For k = 2 To enson3
        s3.Cells(k, "A") = k - 1
    Next
End If
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı!." & Chr(10) & Chr(10) & "Toplam " & enson2 - 1 & " adet alınacak ve" & _
    Chr(10) & Chr(10) & enson3 - 1 & " adet verilecek " & Chr(10) & Chr(10) & "kayıt oluşturulmuştur." _
    & Chr(10) & Chr(10) & "Alınacak Para Toplamı : " & Format(WorksheetFunction.Sum(s2.Range("G2:G" & enson2)), "#,##0.00 TL") _
    & Chr(10) & Chr(10) & "Verilecek Para Toplamı : " & Format(WorksheetFunction.Sum(s3.Range("G2:G" & enson3)), "#,##0.00 TL"), vbExclamation
   
End Sub
 
Son düzenleme:
O

okancicek

Altın Üye
Katılım
22 Nisan 2012
Mesajlar
40
Excel Vers. ve Dili
2010 docx
Altın Üyelik Bitiş Tarihi
24.08.2024
all
YUSUF44' Alıntı:
Aşağıdaki makroyu deneyiniz:

PHP: 
Sub aktar()
Set s1 = Sheets("Liste")
Set s2 = Sheets("alınacak para")
Set s3 = Sheets("verilecek para")
son = s1.Cells(Rows.Count, "C").End(3).Row
eski2 = s2.Cells(Rows.Count, "C").End(3).Row
eski3 = s3.Cells(Rows.Count, "C").End(3).Row
Application.ScreenUpdating = True
If eski2 > 1 Then s2.Range("A2:G" & eski2).ClearContents
If eski3 > 1 Then s3.Range("A2:G" & eski3).ClearContents

Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no;imex=1"""

sorgu = "select distinct F2,F3,F4 from [Liste$A3:I" & son & "] where F3 is not null"
Set rs = con.Execute(sorgu)
s2.[B2].CopyFromRecordset rs
sorgu = "select distinct F2,F3,F4 from [Liste$A3:I" & son & "] where F3 is not null"
Set rs = con.Execute(sorgu)
s3.[B2].CopyFromRecordset rs
enson = s2.Cells(Rows.Count, "C").End(3).Row

For i = enson To 2 Step -1
    If WorksheetFunction.SumIf(s1.Range("C3:C" & son), s2.Cells(i, "C"), s1.Range("I3:I" & son)) > 0 Then
        s2.Cells(i, "G") = WorksheetFunction.SumIf(s1.Range("C3:C" & son), s2.Cells(i, "C"), s1.Range("I3:I" & son))
        s3.Rows(i).Delete
    ElseIf WorksheetFunction.SumIf(s1.Range("C3:C" & son), s3.Cells(i, "C"), s1.Range("I3:I" & son)) < 0 Then
        s3.Cells(i, "G") = WorksheetFunction.SumIf(s1.Range("C3:C" & son), s2.Cells(i, "C"), s1.Range("I3:I" & son)) * (-1)
        s2.Rows(i).Delete
    Else
        s2.Rows(i).Delete
        s3.Rows(i).Delete
    End If
Next
enson2 = s2.Cells(Rows.Count, "C").End(3).Row
If enson2 > 1 Then
    For j = 2 To enson2
        s2.Cells(j, "A") = j - 1
    Next
End If
enson3 = s3.Cells(Rows.Count, "C").End(3).Row
If enson3 > 1 Then
    For k = 2 To enson3
        s3.Cells(k, "A") = k - 1
    Next
End If
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı!." & Chr(10) & Chr(10) & "Toplam " & enson2 - 1 & " adet alınacak ve" & _
    Chr(10) & Chr(10) & enson3 - 1 & " adet verilecek " & Chr(10) & Chr(10) & "kayıt oluşturulmuştur." _
    & Chr(10) & Chr(10) & "Alınacak Para Toplamı : " & Format(WorksheetFunction.Sum(s2.Range("G2:G" & enson2)), "#,##0.00 TL") _
    & Chr(10) & Chr(10) & "Verilecek Para Toplamı : " & Format(WorksheetFunction.Sum(s3.Range("G2:G" & enson3)), "#,##0.00 TL"), vbExclamation
  
End Sub
Genişletmek için tıkla ...
Allah razı olsun henmen deneyecegim
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst