- Katılım
- 18 Temmuz 2009
- Mesajlar
- 56
- Excel Vers. ve Dili
- 2007
- Altın Üyelik Bitiş Tarihi
- 16.03.2019
Bir çek takip hazırlamak istedim. yaptığım çalışmanın bir kısmını gönderdim. Ekteki çalışmamda Tahsil edilenler ve tahsil edilmeyenler aynı sayfada farklı butonlarla gösrerilsin. VERİ sayfasında ÖDENDİ olanlar Tahsil edilenler butonuyla gösterilsin diye bir çalışma yaptım. Bir hata yaptım ama nerede yanlış yazdığımı bilmiyorum yardım edin.
Sub ödenenler()
Dim s1 As Worksheet, sat As Integer
Sheets("ÖDEME").Select
Set s1 = Sheets("VERİ")
Application.ScreenUpdating = False
Range("A2:I65536").ClearContents
sat = 2
sonsat = s1.Cells(65536, "B").End(xlUp).Row
Rows("3:102").Delete
Rows("3:102").Select
Selection.RowHeight = 20#
If s1.Cells(sat, "K").Value = "ÖDENDİ" Then
Do
Cells(sat, "A").Value = s1.Cells(sat, "A").Value
Cells(sat, "B").Value = s1.Cells(sat, "B").Value
Cells(sat, "C").Value = s1.Cells(sat, "C").Value
Cells(sat, "D").Value = s1.Cells(sat, "F").Value
Cells(sat, "E").Value = s1.Cells(sat, "G").Value
Cells(sat, "F").Value = s1.Cells(sat, "D").Value
Cells(sat, "G").Value = s1.Cells(sat, "I").Value
Cells(sat, "H").Value = s1.Cells(sat, "J").Value
Cells(sat, "I").Value = s1.Cells(sat, "K").Value
sat = sat + 1
Loop While sat <= sonsat
End If
Range(Cells(sat - 1, 9), Cells(2, 1)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
End With
Range("G3:G" & sonsat).Select
With Selection
End With
Application.ScreenUpdating = True
ActiveSheet.PageSetup.PrintArea = "$A$1:$I$" & Val(sat + 1)
Range("G2").Select
End Sub
Sub ödenenler()
Dim s1 As Worksheet, sat As Integer
Sheets("ÖDEME").Select
Set s1 = Sheets("VERİ")
Application.ScreenUpdating = False
Range("A2:I65536").ClearContents
sat = 2
sonsat = s1.Cells(65536, "B").End(xlUp).Row
Rows("3:102").Delete
Rows("3:102").Select
Selection.RowHeight = 20#
If s1.Cells(sat, "K").Value = "ÖDENDİ" Then
Do
Cells(sat, "A").Value = s1.Cells(sat, "A").Value
Cells(sat, "B").Value = s1.Cells(sat, "B").Value
Cells(sat, "C").Value = s1.Cells(sat, "C").Value
Cells(sat, "D").Value = s1.Cells(sat, "F").Value
Cells(sat, "E").Value = s1.Cells(sat, "G").Value
Cells(sat, "F").Value = s1.Cells(sat, "D").Value
Cells(sat, "G").Value = s1.Cells(sat, "I").Value
Cells(sat, "H").Value = s1.Cells(sat, "J").Value
Cells(sat, "I").Value = s1.Cells(sat, "K").Value
sat = sat + 1
Loop While sat <= sonsat
End If
Range(Cells(sat - 1, 9), Cells(2, 1)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
End With
Range("G3:G" & sonsat).Select
With Selection
End With
Application.ScreenUpdating = True
ActiveSheet.PageSetup.PrintArea = "$A$1:$I$" & Val(sat + 1)
Range("G2").Select
End Sub
Ekli dosyalar
-
43 KB Görüntüleme: 5