- Katılım
- 8 Mart 2009
- Mesajlar
- 504
- Excel Vers. ve Dili
- 2010
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim alan As Byte, sh As Worksheet
If Intersect(Target, Range("A2:B2,C2,D2")) Is Nothing Then Exit Sub
Cancel = True
If Target.Address = "$A$2" Then
alan = 3
Set sh = Sheets("RAPOR")
ElseIf Target.Address = "$B$2" Then
alan = 8
Set sh = Sheets("RAPOR1")
ElseIf Target.Address = "$D$2" Then
alan = 5
Set sh = Sheets("RAPOR3")
ElseIf Target.Address = "$C$2" Then
alan = 4
Set sh = Sheets("RAPOR2")
End If
If Target <> "" Then
sh.Columns("A:BV").ClearContents
Range("A7").AutoFilter Field:=alan, Criteria1:="=*" & Target & "*"
Range("A7").CurrentRegion.Copy sh.Range("A7")
Range("A7").AutoFilter
sh.Select
sh.Cells.EntireColumn.AutoFit
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End If
Set sh = Nothing
End Sub
Sub ÖZET_RAPOR()
Application.ScreenUpdating = False
Set SL = Sheets("Sayfa1")
Set SR = Sheets("ÖZET RAPOR")
Kriter1 = SL.[D2]
Kriter2 = SL.[H2]
Kriter3 = SL.[I2]
Kriter4 = SL.[J2]
Kriter5 = SL.[K2]
SR.Columns("A:E").Clear
SL.Select
[A1].Select
Selection.AutoFilter
If Kriter1 = "" Then
Selection.AutoFilter Field:=2
Else
Selection.AutoFilter Field:=2, Criteria1:=Kriter1
End If
If Kriter2 = "" Then
Selection.AutoFilter Field:=3
Else
Selection.AutoFilter Field:=3, Criteria1:=Kriter2
End If
If Kriter3 = "" And Kriter4 = "" Then
Selection.AutoFilter Field:=4
ElseIf Kriter3 <> "" And Kriter4 = "" Then
Selection.AutoFilter Field:=4, Criteria1:=">=" & CLng(CDate(Kriter3))
ElseIf Kriter3 = "" And Kriter4 <> "" Then
Selection.AutoFilter Field:=4, Criteria1:="<=" & CLng(CDate(Kriter4))
ElseIf Kriter3 <> "" And Kriter4 <> "" Then
Selection.AutoFilter Field:=4, Criteria1:=">=" & CLng(CDate(Kriter3)), Operator:=xlAnd, Criteria2:="<=" & CLng(CDate(Kriter4))
End If
If Kriter5 = "" Then
Selection.AutoFilter Field:=5
Else
Selection.AutoFilter Field:=5, Criteria1:=">=" & Kriter5
End If
SL.[A7].CurrentRegion.Copy
SR.Select
[A7].Select
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("A:E").EntireColumn.AutoFit
[A1].Select
SL.Select
Selection.AutoFilter
SR.Select
Application.ScreenUpdating = True
SAY = WorksheetFunction.CountA(SR.[A7:A65536])
If SAY = 0 Then MsgBox "VERDİĞİNİZ KRİTERLERE UYGUN KAYIT BULUNAMAMIŞTIR.", vbExclamation, "DİKKAT !"
Exit Sub
MsgBox "VERDİĞİNİZ KRİTERLERE UYGUN " & Format(SAY, "#,##0") & " ADET KAYIT BULUNMUŞTUR.", vbInformation
End Sub
bu iki makroyu nasıl birleştirmem gerekli kod bölümüne girdiğimde düzeltmeye çalıştığımda değişik değişik hatalar alıyorum.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim alan As Byte, sh As Worksheet
If Intersect(Target, Range("A2:B2,C2,D2")) Is Nothing Then Exit Sub
Cancel = True
If Target.Address = "$A$2" Then
alan = 3
Set sh = Sheets("RAPOR")
ElseIf Target.Address = "$B$2" Then
alan = 8
Set sh = Sheets("RAPOR1")
ElseIf Target.Address = "$D$2" Then
alan = 5
Set sh = Sheets("RAPOR3")
ElseIf Target.Address = "$C$2" Then
alan = 4
Set sh = Sheets("RAPOR2")
End If
If Target <> "" Then
sh.Columns("A:BV").ClearContents
Range("A7").AutoFilter Field:=alan, Criteria1:="=*" & Target & "*"
Range("A7").CurrentRegion.Copy sh.Range("A7")
Range("A7").AutoFilter
sh.Select
sh.Cells.EntireColumn.AutoFit
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End If
Set sh = Nothing
End Sub
Sub ÖZET_RAPOR()
Application.ScreenUpdating = False
Set SL = Sheets("Sayfa1")
Set SR = Sheets("ÖZET RAPOR")
Kriter1 = SL.[D2]
Kriter2 = SL.[H2]
Kriter3 = SL.[I2]
Kriter4 = SL.[J2]
Kriter5 = SL.[K2]
SR.Columns("A:E").Clear
SL.Select
[A1].Select
Selection.AutoFilter
If Kriter1 = "" Then
Selection.AutoFilter Field:=2
Else
Selection.AutoFilter Field:=2, Criteria1:=Kriter1
End If
If Kriter2 = "" Then
Selection.AutoFilter Field:=3
Else
Selection.AutoFilter Field:=3, Criteria1:=Kriter2
End If
If Kriter3 = "" And Kriter4 = "" Then
Selection.AutoFilter Field:=4
ElseIf Kriter3 <> "" And Kriter4 = "" Then
Selection.AutoFilter Field:=4, Criteria1:=">=" & CLng(CDate(Kriter3))
ElseIf Kriter3 = "" And Kriter4 <> "" Then
Selection.AutoFilter Field:=4, Criteria1:="<=" & CLng(CDate(Kriter4))
ElseIf Kriter3 <> "" And Kriter4 <> "" Then
Selection.AutoFilter Field:=4, Criteria1:=">=" & CLng(CDate(Kriter3)), Operator:=xlAnd, Criteria2:="<=" & CLng(CDate(Kriter4))
End If
If Kriter5 = "" Then
Selection.AutoFilter Field:=5
Else
Selection.AutoFilter Field:=5, Criteria1:=">=" & Kriter5
End If
SL.[A7].CurrentRegion.Copy
SR.Select
[A7].Select
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("A:E").EntireColumn.AutoFit
[A1].Select
SL.Select
Selection.AutoFilter
SR.Select
Application.ScreenUpdating = True
SAY = WorksheetFunction.CountA(SR.[A7:A65536])
If SAY = 0 Then MsgBox "VERDİĞİNİZ KRİTERLERE UYGUN KAYIT BULUNAMAMIŞTIR.", vbExclamation, "DİKKAT !"
Exit Sub
MsgBox "VERDİĞİNİZ KRİTERLERE UYGUN " & Format(SAY, "#,##0") & " ADET KAYIT BULUNMUŞTUR.", vbInformation
End Sub
bu iki makroyu nasıl birleştirmem gerekli kod bölümüne girdiğimde düzeltmeye çalıştığımda değişik değişik hatalar alıyorum.
