Soru Son satira git ve bi dünya iş yap ...

LifeGame · 24 Mart 2022

Merhabalar;
@muygun hocamın desteği ile bir miktar ilerleyebildim ama bilmeyince takılıp kalıyor insan..

1
Yapmış olduğum excell de Rapor Sayfasında;
H sütunu son dolu satıra git,
H tan O ya kadar olan bölümü Bold yap

2
H sütünunun en son dolu satırının 1 altına in ve dolu satırdan bir öncesinden başyayarak H4 e kadar olan toplamı al.
Aldığın toplamı H ın en son satırı ile karşılaştır. Şayet eşit se dolgu yeşi, eşit değilse dolgu kırmızı.

3
B sütununda bulunan her firma için;
H+I+J+K+L+M+N (ve belkide ileride +O+P) toplamını P ye yaz.
O-P yi Q ya yaz ..

Şimdi siz diyeceksiniz ki arkadaş bunları basit formüller ile niye yapmıyorsun

bu excel süreç içerisinde fena şekiller alacak. O nedenle öğrenem lazım vba ile bu işlemler nasıl yapılır.

Ornek.xlsm

1 file sent via WeTransfer, the simplest way to send your files around the world

we.tl

Mevcut Durum;

Sub bakiyesi_olanları_getir()
Application.ScreenUpdating = False
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("BORC")
Set s2 = ThisWorkbook.Worksheets("Rapor")
s2.Range("B4:O65536").ClearContents
s2.Range("B4:O65536").Borders.LineStyle = xlNone

Sheets("BORC").Select
Selection.AutoFilter Field:=1
Selection.AutoFilter Field:=2
Selection.AutoFilter Field:=3
Selection.AutoFilter Field:=4
Selection.AutoFilter Field:=5
Selection.AutoFilter Field:=6
Selection.AutoFilter Field:=7
Selection.AutoFilter Field:=8
Selection.AutoFilter Field:=9
Selection.AutoFilter Field:=10

Sheets("Rapor").Select
Selection.AutoFilter Field:=1
Selection.AutoFilter Field:=2
Selection.AutoFilter Field:=3
Selection.AutoFilter Field:=4
Selection.AutoFilter Field:=5
Selection.AutoFilter Field:=6
Selection.AutoFilter Field:=7
Selection.AutoFilter Field:=8
Selection.AutoFilter Field:=9
Selection.AutoFilter Field:=10

For i = 13 To s1.Range("B65536").End(xlUp).Row + 1
If s1.Cells(i, "O") < -5 Then
sonsatir = s2.Range("B65536").End(xlUp).Row + 1

For O = 2 To 15
s2.Cells(sonsatir, O) = s1.Cells(i, O)
Next O

s2.Range("B" & sonsatir & ":O" & sonsatir).Borders.LineStyle = xlContinuous
s2.Range("H4" & sonsatir & ":O" & sonsatir).NumberFormat = "$* #,##0;$* #,##0"

End If

Next i
Application.ScreenUpdating = True
MsgBox "Rapor Hazır", vbInformation
End Sub

Şimdiden teşekkürler

YUSUF44 · 24 Mart 2022

Aşağıdaki makroyu deneyin:

PHP:

Sub raporduzenle()
Set s1 = Sheets("Rapor")
son = s1.Cells(Rows.Count, "H").End(3).Row
s1.Range("H" & son & ":O" & son).Font.Bold = True
For j = 8 To 15
    toplam = WorksheetFunction.Sum(s1.Range(Cells(4, j), Cells(son - 1, j)))
    s1.Cells(son + 1, j) = toplam
    If s1.Cells(son, j) = toplam Then
        s1.Cells(son, j).Interior.Color = vbGreen
    Else
        s1.Cells(son, j).Interior.Color = vbRed
    End If
Next
For i = 4 To son - 1
    s1.Cells(i, "P") = WorksheetFunction.Sum(s1.Range("H" & i & ":N" & i))
    s1.Cells(i, "Q") = s1.Cells(i, "O") - s1.Cells(i, "P")
Next
End Sub

muygun · 24 Mart 2022

Merhaba;
Next i satırından sonra;

Rem 1.isteğinizin kodları
sonsatir = s2.Range("h65536").End(xlUp).Row
s2.Range("h" & sonsatir & "

" & sonsatir).Font.Bold = True
Rem 1.isteğinizin kod sonu

Rem 2.isteğinizin kodları
sonn = s2.Range("h65536").End(xlUp).Row + 1
s2.Cells(sonn, "h") = WorksheetFunction.Sum(s2.Range("h4" & ":h" & sonn - 2))
If s2.Cells(sonn, "h") = s2.Cells(sonn - 1, "h") Then s2.Cells(sonn, "h").Interior.ColorIndex = 43
If s2.Cells(sonn, "h") <> s2.Cells(sonn - 1, "h") Then s2.Cells(sonn, "h").Interior.ColorIndex = 3
s2.Cells(sonn, "h").Select
Rem 2.isteğinizin kod sonu

Rem 3.isteğinizin kodları
s2.Range("p4:q65536").ClearContents
For i = 4 To s2.Range("B65536").End(xlUp).Row
s2.Cells(i, "p") = WorksheetFunction.Sum(s2.Range("h" & i & ":n" & i))
s2.Cells(i, "q") = s2.Cells(i, "o") - s2.Cells(i, "p")
Next i
Rem 3.isteğinizin kod sonu

Kodlarını ekleyerek deneyin.
İyi çalışmalar.

LifeGame · 24 Mart 2022

muygun' Alıntı:
Merhaba;
Next i satırından sonra;

Rem 1.isteğinizin kodları
sonsatir = s2.Range("h65536").End(xlUp).Row
s2.Range("h" & sonsatir & "" & sonsatir).Font.Bold = True
Rem 1.isteğinizin kod sonu

Rem 2.isteğinizin kodları
sonn = s2.Range("h65536").End(xlUp).Row + 1
s2.Cells(sonn, "h") = WorksheetFunction.Sum(s2.Range("h4" & ":h" & sonn - 2))
If s2.Cells(sonn, "h") = s2.Cells(sonn - 1, "h") Then s2.Cells(sonn, "h").Interior.ColorIndex = 43
If s2.Cells(sonn, "h") <> s2.Cells(sonn - 1, "h") Then s2.Cells(sonn, "h").Interior.ColorIndex = 3
s2.Cells(sonn, "h").Select
Rem 2.isteğinizin kod sonu

Rem 3.isteğinizin kodları
s2.Range("p4:q65536").ClearContents
For i = 4 To s2.Range("B65536").End(xlUp).Row
s2.Cells(i, "p") = WorksheetFunction.Sum(s2.Range("h" & i & ":n" & i))
s2.Cells(i, "q") = s2.Cells(i, "o") - s2.Cells(i, "p")
Next i
Rem 3.isteğinizin kod sonu

Kodlarını ekleyerek deneyin.
İyi çalışmalar.

Hocam

Cevap için çok teşekkürler.. O hayalete benzeyen surat yerinde ne yazmakta acaba

LifeGame · 24 Mart 2022

YUSUF44' Alıntı:

Aşağıdaki makroyu deneyin:

PHP:

Sub raporduzenle()
Set s1 = Sheets("Rapor")
son = s1.Cells(Rows.Count, "H").End(3).Row
s1.Range("H" & son & ":O" & son).Font.Bold = True
For j = 8 To 15
    toplam = WorksheetFunction.Sum(s1.Range(Cells(4, j), Cells(son - 1, j)))
    s1.Cells(son + 1, j) = toplam
    If s1.Cells(son, j) = toplam Then
        s1.Cells(son, j).Interior.Color = vbGreen
    Else
        s1.Cells(son, j).Interior.Color = vbRed
    End If
Next
For i = 4 To son - 1
    s1.Cells(i, "P") = WorksheetFunction.Sum(s1.Range("H" & i & ":N" & i))
    s1.Cells(i, "Q") = s1.Cells(i, "O") - s1.Cells(i, "P")
Next
End Sub

teşekkürler hocam..
hemen deniyorum

Üstat siz neymişsiniz yaaa.. Bu nasıl bir hız .. acilen öğrenip aranıza katılmalıyım ..

muygun · 24 Mart 2022

iki noktaüstüste ve o harfi

LifeGame · 24 Mart 2022

muygun' Alıntı:
iki noktaüstüste ve o harfi

Hocam;
Son 1 sorum daha olacak.. Son diyorum ama nasip artık

"H4" ten içerisinde veri olan "O" son satıra kadar "0" dan küçük değerlerin metin rengini beyaz yapmaya çalışıyorum.. bunu nasıl yapabilirim acaba?

Kodumuzun son hali:

Sub Borclar_TL()
Application.ScreenUpdating = False
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("BORC")
Set s2 = ThisWorkbook.Worksheets("RaporTL")
s2.Range("B4:O65536").ClearContents
s2.Range("B4:O65536").Borders.LineStyle = xlNone

For I = 13 To s1.Range("B65536").End(xlUp).Row + 1
If s1.Cells(I, "O") < -5 Then
sonsatir = s2.Range("B65536").End(xlUp).Row + 1
For O = 2 To 15
s2.Cells(sonsatir, O) = s1.Cells(I, O)
Next O

s2.Range("B" & sonsatir & ":O" & sonsatir).Borders.LineStyle = xlContinuous
s2.Range("P" & sonsatir & "

" & sonsatir).Font.ColorIndex = 2
s2.Range("H4" & sonsatir & ":O" & sonsatir).NumberFormat = "$* #,##0;$* #,##0"

End If
Next I

sonsatir = s2.Range("H65536").End(xlUp).Row
s2.Range("H" & sonsatir & ":O" & sonsatir).Font.Bold = True

s2.Range("P4:Q65536").ClearContents
For I = 4 To s2.Range("B65536").End(xlUp).Row
s2.Cells(I, "P") = WorksheetFunction.Sum(s2.Range("H" & I & ":N" & I))
s2.Cells(I, "Q") = s2.Cells(I, "O") - s2.Cells(I, "P")

Next I
Application.ScreenUpdating = True
MsgBox "Degerler Guncellendi", vbInformation, "TL Borçlar"

End Sub

muygun · 25 Mart 2022

Merhaba;
Next I satırından sonra;

For i = 4 To ActiveCell.SpecialCells(xlLastCell).Row
For k = 8 To 17
If s2.Cells(i, k) < 0 Then
s2.Cells(i, k).Font.ColorIndex = 2
End If
Next k
Next i

Kodlarını yerleştirip deneyin.
İyi çalışmalar.

LifeGame · 25 Mart 2022

muygun' Alıntı:
Merhaba;
Next I satırından sonra;

For i = 4 To ActiveCell.SpecialCells(xlLastCell).Row
For k = 8 To 17
If s2.Cells(i, k) < 0 Then
s2.Cells(i, k).Font.ColorIndex = 2
End If
Next k
Next i

Kodlarını yerleştirip deneyin.
İyi çalışmalar.

Merhaba hocam;
Evet bu şekilde çalıştı ama bu kod satırı olmadan günceleme 2sn sürerken bu kodları eklediğimde güncelleme süresi 20sn ye çıkıyor..

LifeGame · 25 Mart 2022

muygun' Alıntı:
Merhaba;
Next I satırından sonra;

For i = 4 To ActiveCell.SpecialCells(xlLastCell).Row
For k = 8 To 17
If s2.Cells(i, k) < 0 Then
s2.Cells(i, k).Font.ColorIndex = 2
End If
Next k
Next i

Kodlarını yerleştirip deneyin.
İyi çalışmalar.

Üstadım;

Senin vermiş olduğun kodu şu şekilde revize ettim;

For I = 4 To Range("H4").End(xlDown).Row
For K = 8 To 15
If s2.Cells(I, K) > -5 Then
s2.Cells(I, K).Font.ColorIndex = 2
End If
Next K
Next I

ve sanırım oldu gibi.. Ne dersin ?

YUSUF44 · 25 Mart 2022

Bu işleminizde koşullu biçimlendirme kullanmak daha hızlı olabilir:

PHP:

    Range("H4:O" & son - 1).FormatConditions.Delete
    Range("H4:O" & son - 1).FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
        Formula1:="=0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False

Bu arada örnek dosyanızdaki tüm veriler zaten 0'dan küçük olduğu için sayfa bembeyaz oluyor

muygun · 25 Mart 2022

Merhaba;
Syn. YUSUF44 'ün önerisini deneyin.
olmaz ise sayfanızı yeniden düzenlemekle sonuç alınabilir.
Ekteki gibi...

Link:
https://s5.dosya.tc/server6/7a9zxr/LifeGame-Ornek-1.zip.html

Not: Son yazdığım ve zamanı uzattı dediğiniz kodda;
For i = 4 To ActiveCell.SpecialCells(xlLastCell).Row
satırı sayfadaki son dolu satır kadar döner
Demekki sayfada bir yerlerde dolu hücre varki zaman bu kadar uzuyor.

LifeGame · 25 Mart 2022

YUSUF44' Alıntı:
Bu işleminizde koşullu biçimlendirme kullanmak daha hızlı olabilir:

PHP:

Range("H4:O" & son - 1).FormatConditions.Delete Range("H4:O" & son - 1).FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _ Formula1:="=0" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Font .ThemeColor = xlThemeColorDark1 .TintAndShade = 0 End With Selection.FormatConditions(1).StopIfTrue = False

Bu arada örnek dosyanızdaki tüm veriler zaten 0'dan küçük olduğu için sayfa bembeyaz oluyor

Sorma hocam

malum hesap planı.. borç - yazııyor

onu raporda kafa karıştırmasın diye alttaki ile kaldırıyorum

s2.Range("H4" & sonsatir & ":O" & sonsatir).NumberFormat = "$* #,##0;$* #,##0"

Asıl kafama takılan daha faklı şu anda. Şimdi biz kaynaktaki verinin 2 den 15 olan kısmında O sütunundaki koşula uyanlarını alttaki kod ile rapora çektik.

For I = 13 To s1.Range("B65536").End(xlUp).Row + 1
If s1.Cells(I, "O") < -5 Then
sonsatir = s2.Range("B65536").End(xlUp).Row + 1
For O = 2 To 15
s2.Cells(sonsatir, O) = s1.Cells(I, O)
Next O
End If
Next I

peki ben bu işlemi yaparken arada sutun atlamak isersem kod nasıl olacak. Örneğin 2 to 3 ve 8 to 15 i almak istersem.. aradaki 4 to 7 yi pas geçmek istersem kod nasıl olacak ?

YUSUF44 · 25 Mart 2022

Aşağıdaki gibi olabilir:

PHP:

For I = 13 To s1.Range("B65536").End(xlUp).Row + 1
    If I < 4 or I > 7 Then
        If s1.Cells(I, "O") < -5 Then
            sonsatir = s2.Range("B65536").End(xlUp).Row + 1
            For O = 2 To 15
                s2.Cells(sonsatir, O) = s1.Cells(I, O)
            Next O
        End If
    End If
Next I

LifeGame · 25 Mart 2022

@muygun hocam. Range("B65536").End(xlUp).Row + 1 ile kasılmanın önüne geçebildik. Teşekkürler. @YUSUF44 hocamın aralık çekmesi için verdiği kodu uygulamay açlıırken başka birşeyi fark ettim.

En başından kurgu hatası yapmışım. Şöyleki;
Kriter olarak belirlediğimiz O11 aslında değişken (If s1.Cells(I, "O") < -5 Then) .. Farklı koşullarda M11 yada N11 de olabiliyor ve bunun da önü açık.

Bu nedenle ilk olarak BORC sayfası 11. satırda "Genel Toplam" kelimesini bulup bulunduğu sütunun 1 altından başlayarak < -5 değerleri almam gerekiyor. Bunu nasıl yaparız peki hocam?

For I = 13 To s1.Range("B65536").End(xlUp).Row + 1
If s1.Cells(I, "O") < -5 Then
sonsatir = s2.Range("B65536").End(xlUp).Row + 1
For O = 2 To 15
s2.Cells(sonsatir, O) = s1.Cells(I, O)
Next O

Ornek.xlsm

1 file sent via WeTransfer, the simplest way to send your files around the world

we.tl

muygun · 25 Mart 2022

Merhaba;
Doğru anladığımı sanmıyorum ama yinede;

BORC sayfası kod bölümüne;

Sub analiz()
Application.ScreenUpdating = False
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("BORC")
For süt = 1 To s1.Cells(111, 256).End(xlToLeft).Column
If s1.Cells(11, süt) = "Genel Toplam" Then
For k = 13 To s1.Cells(Rows.Count, süt).End(xlUp).Row
s1.Cells(k, süt + 1) = ""
If s1.Cells(k, süt) < 0 Then
If Abs(s1.Cells(k, süt)) <= 5 Then
s1.Cells(k, süt + 1) = Abs(s1.Cells(k, süt))
End If
End If
Next k
End If
Next süt
Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub

Kodlarını ekleyin ve çalıştırın.
istediğiniz satırlar P sütununda veri olan satırlar mı? kontrol edin.
Doğru ise diğer sayfaya almak (kendinizde halledebilirsiniz) basitleşecek.

İyi çalışmalar.

LifeGame · 26 Mart 2022

muygun' Alıntı:
Merhaba;
Doğru anladığımı sanmıyorum ama yinede;

BORC sayfası kod bölümüne;

Sub analiz()
Application.ScreenUpdating = False
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("BORC")
For süt = 1 To s1.Cells(111, 256).End(xlToLeft).Column
If s1.Cells(11, süt) = "Genel Toplam" Then
For k = 13 To s1.Cells(Rows.Count, süt).End(xlUp).Row
s1.Cells(k, süt + 1) = ""
If s1.Cells(k, süt) < 0 Then
If Abs(s1.Cells(k, süt)) <= 5 Then
s1.Cells(k, süt + 1) = Abs(s1.Cells(k, süt))
End If
End If
Next k
End If
Next süt
Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub

Kodlarını ekleyin ve çalıştırın.
istediğiniz satırlar P sütununda veri olan satırlar mı? kontrol edin.
Doğru ise diğer sayfaya almak (kendinizde halledebilirsiniz) basitleşecek.

İyi çalışmalar.

Üstat;

Verdiğin kodları aşşağıdaki şekilde ekledim;

Kod:

Sub analiz()
Application.ScreenUpdating = False
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("BORC")
    For süt = 1 To s1.Cells(111, 256).End(xlToLeft).Column
        If s1.Cells(11, süt) = "Genel Toplam" Then
            For k = 13 To s1.Cells(Rows.Count, süt).End(xlUp).Row
            s1.Cells(k, süt + 1) = ""
                If s1.Cells(k, süt) < 0 Then
                    If Abs(s1.Cells(k, süt)) > 5 Then
                    s1.Cells(k, süt + 1) = Abs(s1.Cells(k, süt))
                    End If
                End If
            Next k
        End If
    Next süt
End Sub

Evet "P" sütununda istediğim değerler var dibiliriz ama - bakiyeler + bakiyeye dönüşerek P ye geldi. Aslında burası usun bir hadise ve konu benim tarafımdan çokça değiştirildiği için size özelden yazdım

Forumu kirletmemek adına. Yapmak istediğimi tamamladığımda yine burada örnek çalışma ve sorun çözümü olarak paylaşırız.

Teşekkürler

Soru Son satira git ve bi dünya iş yap ...

LifeGame

Ornek.xlsm

YUSUF44

Destek Ekibi

muygun

Özel Üye

LifeGame

LifeGame

muygun

Özel Üye

LifeGame

muygun

Özel Üye

LifeGame

LifeGame

YUSUF44

Destek Ekibi

muygun

Özel Üye

Ekli dosyalar

LifeGame

YUSUF44

Destek Ekibi

LifeGame

Ornek.xlsm

muygun

Özel Üye

LifeGame