• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Aynı sahifede çalışan aynı iki kod sorunu

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
 
Son düzenleme:
ustadlar merhaba,
Yardımcı olabilrseniz sevinirim.
Tşk.
 
Aşağıdaki 1 nci kodun sonundaki end sub ve ikinci kod başlığı silinerek sorun çözülmüştür.
Selametle kalın.
 
Geri
Üst