- Katılım
- 14 Kasım 2017
- Mesajlar
- 618
- Excel Vers. ve Dili
- 2010 Türkçe
- Altın Üyelik Bitiş Tarihi
- 07-01-2024
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Hocam ben bunu kendi dosyamda Sipariş sayfasında X9 hücresine göre uyarlayamadım. Ne yaptıysam olmadı sürekli başka sorunlar çıktı. Rica etsem kodun Sipariş sayfasında X9 hücresinde çalışması için kodun neresinde değişiklik yapmam gerektiğini söyleyebilir misin ?
Sub az()
Sheets("Sipariş").Range("x9").Select
UserForm1.Show
End Sub
Option Explicit
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim S1 As Worksheet, BUL As Range
If Intersect(Target, Range("A1:A30")) Is Nothing Then Exit Sub
Cancel = True
If Target <> "" Then
Application.EnableEvents = False
Set S1 = Sheets("Veri")
If WorksheetFunction.CountIf(S1.Range("B:B"), "*" & Target & "*") = 1 Then
Set BUL = S1.Cells.Find(Target)
If Not BUL Is Nothing Then
Target = BUL.Value
End If
Else
ANIMSATICI
End If
Set S1 = Nothing
Set BUL = Nothing
Else
ANIMSATICI
End If
Son:
Application.EnableEvents = True
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim S1 As Worksheet, BUL As Range
If Intersect(Target, Range("A1:A30")) Is Nothing Then Exit Sub
On Error GoTo Son
If Target.Cells.Count > 1 Then Exit Sub
If Target <> "" Then
Application.EnableEvents = False
Target.Select
Set S1 = Sheets("Veri")
If WorksheetFunction.CountIf(S1.Range("B:B"), "*" & Target & "*") = 1 Then
Set BUL = S1.Cells.Find(Target)
If Not BUL Is Nothing Then
Target = BUL.Value
End If
Else
ANIMSATICI
End If
Set S1 = Nothing
Set BUL = Nothing
End If
Son:
Application.EnableEvents = True
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name <> "Sipariş" Then Exit Sub
If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then Exit Sub
If Val(Application.Version) < 12 Then
ShowAtCell_1
Else
ShowAtCell_2
End If
End Sub