kemal turan
Altın Üye
- Katılım
- 10 Haziran 2011
- Mesajlar
- 1,677
- Excel Vers. ve Dili
- Excel 2010 32 bit
merhaba ustadlar,
Aynı sahifede aşağıda kodla başlayan kodumuz var.
Her iki kodun çalışabilmesi için ne gibi bir ekleme veya değişiklik yapılması gerekir.
Teşekkürler
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("K16:K42")) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If Target <> "" Then
Range("AY16:BB42").ClearContents
Satır = 16
Set BUL = Sheets("SATIŞLAR").Range("A:A").Find(Target)
If Not BUL Is Nothing Then
Range("AW11") = BUL.Value
ADRES = BUL.Address
Do
If UCase(BUL.Offset(0, 10)) <> "SEVK OLDU" Then
Cells(Satır, "AY") = BUL.Offset(0, 16)
Cells(Satır, "AZ") = BUL.Offset(0, 10)
Cells(Satır, "BA") = BUL.Offset(0, 1)
Cells(Satır, "BB") = BUL.Offset(0, 9)
Satır = Satır + 1
End If
Set BUL = Sheets("SATIŞLAR").Range("A:A").FindNext(BUL)
Loop While Not BUL Is Nothing And BUL.Address <> ADRES
End If
End If
Set BUL = Nothing
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
KOD 2
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
c = 0
If Not Intersect(Target, [a2:a65536]) Is Nothing Then
[b2:E65536].ClearContents
If Target = "" Then Exit Sub
For a = 2 To [STOK!a65536].End(3).Row
If Sheets("stok").Cells(a, "a") = Target Then
c = c + 1
If WorksheetFunction.CountIf([b:b], Sheets("stok").Cells(a, "b")) = 0 Then
Cells(c + 1, "b") = Sheets("stok").Cells(a, "b")
End If
End If
Next
[b2:b65536].Sort Key1:=[b2], Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End If----DEVAM EDİYOR
Aynı sahifede aşağıda kodla başlayan kodumuz var.
Her iki kodun çalışabilmesi için ne gibi bir ekleme veya değişiklik yapılması gerekir.
Teşekkürler
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("K16:K42")) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If Target <> "" Then
Range("AY16:BB42").ClearContents
Satır = 16
Set BUL = Sheets("SATIŞLAR").Range("A:A").Find(Target)
If Not BUL Is Nothing Then
Range("AW11") = BUL.Value
ADRES = BUL.Address
Do
If UCase(BUL.Offset(0, 10)) <> "SEVK OLDU" Then
Cells(Satır, "AY") = BUL.Offset(0, 16)
Cells(Satır, "AZ") = BUL.Offset(0, 10)
Cells(Satır, "BA") = BUL.Offset(0, 1)
Cells(Satır, "BB") = BUL.Offset(0, 9)
Satır = Satır + 1
End If
Set BUL = Sheets("SATIŞLAR").Range("A:A").FindNext(BUL)
Loop While Not BUL Is Nothing And BUL.Address <> ADRES
End If
End If
Set BUL = Nothing
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
KOD 2
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
c = 0
If Not Intersect(Target, [a2:a65536]) Is Nothing Then
[b2:E65536].ClearContents
If Target = "" Then Exit Sub
For a = 2 To [STOK!a65536].End(3).Row
If Sheets("stok").Cells(a, "a") = Target Then
c = c + 1
If WorksheetFunction.CountIf([b:b], Sheets("stok").Cells(a, "b")) = 0 Then
Cells(c + 1, "b") = Sheets("stok").Cells(a, "b")
End If
End If
Next
[b2:b65536].Sort Key1:=[b2], Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End If----DEVAM EDİYOR
Son düzenleme:
