igultekin2000
Altın Üye
- Katılım
- 5 Eylül 2007
- Mesajlar
- 1,238
- Excel Vers. ve Dili
- ofis 2010
- Altın Üyelik Bitiş Tarihi
- 21-07-2024
iyi günler; benzer soruları soruyormuş gibi oluyor, ama bir işlemde kullandığım makroyu başka çalışmada kullanmaya kalkınca, ya ilave gerekiyor yada farklı bir revize, bu çalışmamda D vade sütunu, E Giriş, F Çıkış sütunu, yapmak istediğim vadeleri eşit giriş ve çıkışların bulunduğu satırları silmek. uygulamaya çalıştığım makro şu şekildedir ;
Teşekkürler.
Teşekkürler.
Kod:
Sub satirsil()
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
son = Cells(Rows.Count, 1).End(3).Row
Columns("K:L").Insert Shift:=xlToRight
For s = 2 To son
If Cells(s, "E") > 0 Then Cells(s, "K") = Cells(s, "D") & Cells(s, "E")
If Cells(s, "F") > 0 Then Cells(s, "K") = Cells(s, "D") & Cells(s, "F")
Next
With Range("L2:L" & son)
.Formula = "=COUNTIF($K$2:$K$" & son & ",K2)": .Value = .Value
End With
For sat = son To 2 Step -1
If WorksheetFunction.IsEven(Cells(sat, "L").Value) = True Then Rows(sat).Delete Shift:=xlUp
Next
Columns("K:L").Delete Shift:=xlToLeft
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İŞLEM TAMAMLANDI"
End Sub
Sub Bosluk_Tmz()
' özel indirim işlemi için
On Error Resume Next
son = Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
Cells.Replace Chr(160), ""
For Each huc In ActiveSheet.Range("E2:F" & son) 'UsedRange
huc.Select
huc.Value = Trim(huc.Value)
Next
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End Sub
Sub sayicevir()
'özel işlem menüsü
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
NoA = Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
For i = 2 To NoA
Range("E" & i) = Range("F" & i) + 0
Next
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End Sub
Sub sayicevir1()
'özel işlem menüsü
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
NoA = Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
For i = 2 To NoA
Range("F" & i) = Range("G" & i) + 0
Next
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End Sub
Sub tekmakro()
Bosluk_Tmz
sayicevir
sayicevir1
End Sub
Private Sub CommandButton1_Click()
tekmakro
satirsil
End Sub