Skip to main content

AccessTr.neT


Access Tablo Makro Olayı

Access Tablo Makro Olayı

#7
Il-ilçe-semt mantığında veri sayisini minimumda tutmak icin 3 farklı tablo olur kurulan ilişkiyle sizin gösterdiğiniz şekilde yapilabilir. Ama aynı tabloda olur mu bilemiyorum.
Cevapla
#8
İl ilçe semt olayında semte gerek yok.

Ben bir Excel ile örnek yapayım orda anlatayım derdimi en iyisi.

Excelde bu iş dolaylı funksiyonu ve veridoğrulama ile basitçe oluyor abey.

Videolu anlatsam videoyu nasıl eklegeceğim foruma gif ile olmadan.
Cevapla
#9
Bu ilk mesajdaki resimde olan yerleri biri açıklayabilirmi nasıl kullanıyor.
Cevapla
#10
Video ekledim belki anlaşılır.

Cevapla
#11
Bu videoda sanırım tam anlatabildim.Yani Access tabloyu Excel gibi düşünebilirsiniz videoya göre.






Kodlarda aşağıda excelin.Kodlar A,B ve C sütununa tıklayınca çalışıyor.Kabaca hazırladım kodları test amaçlı video için.

Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim scr As New Scripting.Dictionary
    Dim i As Integer

'--------------------------A sütununa göre------------------------------------------

    If Not Intersect([A:A], Target) Is Nothing Then
        For i = 1 To Cells(Rows.Count, 1).End(3).Row
          If Cells(i, 1).Value <> "" Then scr(Cells(i, 1).Value) = scr(Cells(i, 1).Value)
        Next

        With Selection.Validation
            .Delete
          On Error GoTo var1
            .Add Type:=xlValidateList, Formula1:=Application.Transpose(Join(scr.Keys, ","))
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = False
            .ShowError = False
            GoTo son
var1:
If scr.Count = 0 Then GoTo son
If Target.Offset(0, -1).Value = "" Then GoTo son
        .Add Type:=xlValidateList, Formula1:=Target.Offset(0, -1).Value
   
        End With
    End If
'--------------------------B sütununa göre------------------------------------------

    If Not Intersect([B:B], Target) Is Nothing Then
        For i = 1 To Cells(Rows.Count, 1).End(3).Row
            If Target.Offset(0, -1).Value = Cells(i, 1).Value Then
              If Cells(i, 2).Value <> "" Then
                    scr(Cells(i, 2).Value) = scr(Cells(i, 2).Value)
              End If
            End If
        Next
       
 
        With Selection.Validation
            .Delete
        On Error GoTo var2
          If scr.Count = 0 Then GoTo son
            .Add Type:=xlValidateList, Formula1:=Application.Transpose(Join(scr.Keys, ","))
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = False
            .ShowError = False
            GoTo son
var2:
        If Target.Offset(0, -1).Value = "" Then GoTo son
        .Add Type:=xlValidateList, Formula1:=Target.Offset(0, -1).Value
        End With
    End If

'--------------------------C sütununa göre------------------------------------------
    If Not Intersect([C:C], Target) Is Nothing Then
        For i = 1 To Cells(Rows.Count, 1).End(3).Row
            If Target.Offset(0, -2).Value & "|" & Target.Offset(0, -1).Value = _
              Cells(i, 1).Value & "|" & Cells(i, 2).Value Then
                If Cells(i, 3).Value <> "" Then
                    scr(Cells(i, 3).Value) = scr(Cells(i, 3).Value)
                End If
            End If
        Next
       
     
        With Selection.Validation
            .Delete
          On Error GoTo var3
          If scr.Count = 0 Then GoTo son
            .Add Type:=xlValidateList, Formula1:=Application.Transpose(Join(scr.Keys, ","))
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = False
            .ShowError = False
            GoTo son
var3:
      If Target.Offset(0, -1).Value = "" Then GoTo son
        .Add Type:=xlValidateList, Formula1:=Target.Offset(0, -1).Value
        End With

       
    End If

son:

    Set scr = Nothing
End Sub

Cevapla
#12
Konuyu silebilirsiniz heralde kimse anlamıyor yada çözüm yok.

Youtubedende videolatı sildim.
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task