Tablodaki Kişileri Aynı Tabloya Eklemek Veya Kopyalamak

1 2 3
23/01/2020, 18:24

fkilic76

Üstatlara ve tüm üyelere selamlar.
yapmak istediğim proje gereği, 12 ay boyunca aynı kişileri ve hesapları  ay başlığı altında tutacağım 
ocak ayındaki kişileri şubat ayına daha sonra şubattan mart a gibi aktaracağım. mümkünmüdür.
aktarma detayları ve proje ektedir. "ayaktar" formunu açınca göreceksiniz
02/02/2020, 16:01

mehmetdemiral

Tablo yapınız yanlış. Aylar için sadece ay id ve adını bulunduran bir tablo yapın. Ay içindeki hareketler için de ayrı bir tablo yapın yıl ve ay bilgisi olsun. Bu arada o ay için kaydedilecek kişiler de bu tabloda olsun. Sonra da bir güncelleştirme sorgusu yapın, kriter olarak açılan kutu verilerinize bağlı bir güncelleme sorgusuyla, aynı kişilere ait bilgilerin sadece ay id değerini 1 iken 2 yapıp tabloya eklesin. Yapmaya çalışın, başaramazsanız yardımcı oluruz.
02/02/2020, 18:12

feraz

Listboxtta listelemek istiyorsanız alttaki kodu deneyebilirsiniz.Tabii doğru anladıysam.

Sql =   buraya ilgili alan adlarını giriniz ben isime kadar yazdım.


Private Sub Aktar_Click()
   
   
    Dim Sql As String
    Dim rs As Object
    Dim cn As Object
   
    Set rs = CreateObject("ADODB.Recordset")
    Set cn = CreateObject("ADODB.Connection")
   
    Sql = "select id,ap_id,replace(ay_id,'" & cmbay1.Column(0) & "','" & cmbay2.Column(0) & "') as [ay id],kisi_id,tcno,isim from hesap where [ay_id] = " & cmbay1.Column(0) & ""
   
    If Me.cmbay1.Value = "" Or IsNull(cmbay1.Value) Then GoTo son
    If cmbay2.Value = "" Or IsNull(cmbay2.Value) Then GoTo son

   
        With cn
        If .State = adStateOpen Then
            .Close
            Set cn = Nothing
        End If
    End With

    Set cn = CurrentProject.Connection
   
    With rs
        If .State = adStateOpen Then .Close
        .CursorType = adOpenDynamic
        .CursorLocation = 3
        .LockType = adLockOptimistic
        .Open Sql, cn
    End With
   
 
    Liste15.ColumnCount = rs.Fields.Count
    Liste15.ColumnWidths = "1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM"
    Liste15.ColumnHeads = True

    Set Liste15.Recordset = rs

    rs.Close
    cn.Close
    Set rs = Nothing
    Set cn = Nothing
  Exit Sub
02/02/2020, 18:46

fkilic76

feraz üstat  yanlış anlamışsınız.hesap tablosundaki ay_id:1olanları yine aynı tabloda ay_id=2 olacak şekilde yeniden kaydetmek  istiyorum
02/02/2020, 19:17

feraz

strSQL = "UPDATE hesap " & _
                    "SET ay_id = " & cmbay2.Column(0) & " WHERE ay_id = " & cmbay1.Column(0) & ""
       
        CurrentDb.Execute strSQL

Yukarıdaki kodu ekledim.


Private Sub Aktar_Click()
   
   
    Dim Sql As String
    Dim rs As Object
    Dim cn As Object
   
    Set rs = CreateObject("ADODB.Recordset")
    Set cn = CreateObject("ADODB.Connection")
   
    Sql = "select id,ap_id,replace(ay_id,'" & cmbay1.Column(0) & "','" & cmbay2.Column(0) & "') as [ay id],kisi_id,tcno,isim from hesap where [ay_id] = " & cmbay1.Column(0) & ""
   
    If Me.cmbay1.Value = "" Or IsNull(cmbay1.Value) Then GoTo son
    If cmbay2.Value = "" Or IsNull(cmbay2.Value) Then GoTo son

   
        With cn
        If .State = adStateOpen Then
            .Close
            Set cn = Nothing
        End If
    End With

    Set cn = CurrentProject.Connection
   
    With rs
        If .State = adStateOpen Then .Close
          .CursorLocation = adUseClient
          .CursorType = adOpenKeyset
          .LockType = adLockOptimistic
       
        .Open Sql, cn
    End With
   
 
    Liste15.ColumnCount = rs.Fields.Count
    Liste15.ColumnWidths = "1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM"
    Liste15.ColumnHeads = True

    Set Liste15.Recordset = rs
    rs.Close
    cn.Close
    Set rs = Nothing
    Set cn = Nothing


strSQL = "UPDATE hesap " & _
                    "SET ay_id = " & cmbay2.Column(0) & " WHERE ay_id = " & cmbay1.Column(0) & ""
       
        CurrentDb.Execute strSQL


  Exit Sub
   
son:
  MsgBox "Combolar bos olamaz", vbCritical
End Sub
02/02/2020, 19:25

feraz

Alttaki gibi değiştirin kod kısaldı.

Not comboların adlarını değiştirmiştim kolaylık olsun diye cmbay1 ve cmbay2 olarak.

Private Sub Aktar_Click()
   
   
    Dim Sql As String
    Dim rs As Object
    Dim cn As Object
   
    Set rs = CreateObject("ADODB.Recordset")
    Set cn = CreateObject("ADODB.Connection")
   
   
    If Me.cmbay1.Value = "" Or IsNull(cmbay1.Value) Then GoTo son
    If cmbay2.Value = "" Or IsNull(cmbay2.Value) Then GoTo son


    strSQL = "UPDATE hesap " & _
                    "SET ay_id = " & cmbay2.Column(0) & " WHERE ay_id = " & cmbay1.Column(0) & ""
       
        CurrentDb.Execute strSQL
   
      Sql = "select * from hesap"
   
   
        With cn
        If .State = adStateOpen Then
            .Close
            Set cn = Nothing
        End If
    End With

    Set cn = CurrentProject.Connection
   
    With rs
        If .State = adStateOpen Then .Close
          .CursorLocation = adUseClient
          .CursorType = adOpenKeyset
          .LockType = adLockOptimistic
       
        .Open Sql, cn
    End With
   
 
    Liste15.ColumnCount = rs.Fields.Count
    Liste15.ColumnWidths = "1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM;1CM"
    Liste15.ColumnHeads = True

    Set Liste15.Recordset = rs
    rs.Close
    cn.Close
    Set rs = Nothing
    Set cn = Nothing

  Exit Sub
   
son:
  MsgBox "Combolar bos olamaz", vbCritical
End Sub
1 2 3