Skip to main content

AccessTr.neT


Buton Yardımı İle Sheet1 Deki Bilgileri Sheet2'ye Alt Alta Sıralı Olarak Kopyalama

Buton Yardımı İle Sheet1 Deki Bilgileri Sheet2'ye Alt Alta Sıralı Olarak Kopyalama

Çözüldü #1
Excel sayfasına veri giriş olarak yaptığım bilgiler başka sayfada çıktı olarak alınmaktadır. Buton yardımı ile Muvafakat sayfasındaki bilgileri veri sayfasına kopyalayarak alt alta sırlama yaptırıp ve aynı butonlada aynı bilgi varsa kopyalama yapmasın istiyorum. Ekli sayfada beceremedim. Lütfen yardım edin.
.rar Muvafakatname.rar (Dosya Boyutu: 135,2 KB | İndirme Sayısı: 3)
Son Düzenleme: 27/02/2020, 17:26, Düzenleyen: HORZUM.
Cevapla
#2
muvafakat sayfanızda boş bir şablon var siz yanılmıyorsam form ile buraya bilgi aktarıp sonrada bu verileri veri sayfasına mı yazdıracaksınız?
biraz daha bilgi verip sonucu gösteren yeni Excel dosyasını ekler misiniz. görebildiğim kadarıyla verisayfasında sadece 1
,2,3,4 gibi sayılar var hangi veri nereye yazılacak? aynı veri var mı kontrol edilecek mi? varsa güncellenecek mi yoksa göz ardı mı edilecek bu kontrol hangi sütuna göre yapılacak.
Cevapla
#3
(02/03/2020, 16:00)berduş yazdı: muvafakat sayfanızda boş bir şablon var siz yanılmıyorsam form ile buraya bilgi aktarıp sonrada bu verileri veri sayfasına mı yazdıracaksınız?
biraz daha bilgi verip sonucu gösteren yeni Excel dosyasını ekler misiniz. görebildiğim kadarıyla verisayfasında sadece 1
,2,3,4 gibi sayılar var hangi veri nereye yazılacak? aynı veri var mı kontrol edilecek mi? varsa güncellenecek mi yoksa göz ardı mı edilecek bu kontrol hangi sütuna göre yapılacak.
İlk olarak özür dilerim yanlış çalışmayı göndermişim. Giriş sayfasına giriş yaptığım verileri veri sayfasına kaydet butonuyla aktarabiliyorum. veri sayfasında aynı kayıt var ise beni uyarsın yeni bir kayıt yapmasın istiyorum. Çalışmayı tekrar yüklüyorum.
.rar Muvafakatname.rar (Dosya Boyutu: 89,68 KB | İndirme Sayısı: 4)
Cevapla
#4
aynı veri olup olmadığını hangi alana gore belirleyecek? Şu an inceleme fırsatım olmadığı için sordum, tekrar dönüşlerde zaman kaybı çok oluyor
Cevapla
#5
Kod:
   Option Compare Text

    Dim sayfaveri
    Dim i As Long, kriter1 As String, kriter2 As String
    Dim son As Long, j As Byte
    Dim arr, scr As Object
   
    arr = Array("K5", "K4", "K6", "A10", "A14", "Y18", "Y19", "A25", "C28", "G41", "G42", "G43", "U43", "U44", "U45")
   
    Application.ScreenUpdating = False
   
    For j = LBound(arr) To UBound(arr)
        kriter2 = kriter2 & Worksheets("MUVAFAKAT").Range(arr(j)).Value & "|"
    Next
   
    kriter2 = Mid(kriter2, 1, Len(kriter2) - 1)
   
    son = Worksheets("VERÝ").Range("A" & Rows.Count).End(3).Row
   
    For i = 2 To son
        For j = 1 To 15
            kriter1 = kriter1 & Worksheets("VERÝ").Cells(i, j).Value & "|"
        Next
       
        kriter1 = Mid(kriter1, 1, Len(kriter1) - 1)
        If kriter1 = kriter2 Then GoTo son
        kriter1 = vbNullString
    Next
   
   
    Erase arr
    kriter1 = vbNullString
    kriter2 = vbNullString

Kod:
son:
    MsgBox "Mükerrer Kayit", vbCritical, "Mükerrer"

    Erase arr
    kriter1 = vbNullString
    kriter2 = vbNullString
Application.ScreenUpdating = True



Yukarıdaki kodları ekledim.Tamamı altta .Tabii
mantık hatasıda olmuş olabilir tam anlaşılmadığından.Kodunuza bakarak MUVAFAKAT sayfasından veri sayfasına aktarıldığını düşünerek yaptım.

Kod:
Option Compare Text

Sub Makro2()


    Dim sayfaveri
    Dim i As Long, kriter1 As String, kriter2 As String
    Dim son As Long, j As Byte
    Dim arr, scr As Object
   
    arr = Array("K5", "K4", "K6", "A10", "A14", "Y18", "Y19", "A25", "C28", "G41", "G42", "G43", "U43", "U44", "U45")
   
    Application.ScreenUpdating = False
   
    For j = LBound(arr) To UBound(arr)
        kriter2 = kriter2 & Worksheets("MUVAFAKAT").Range(arr(j)).Value & "|"
    Next
   
    kriter2 = Mid(kriter2, 1, Len(kriter2) - 1)
   
    son = Worksheets("VERÝ").Range("A" & Rows.Count).End(3).Row
   
    For i = 2 To son
        For j = 1 To 15
            kriter1 = kriter1 & Worksheets("VERÝ").Cells(i, j).Value & "|"
        Next
       
        kriter1 = Mid(kriter1, 1, Len(kriter1) - 1)
        If kriter1 = kriter2 Then GoTo son
        kriter1 = vbNullString
    Next
   
   
    Erase arr
    kriter1 = vbNullString
    kriter2 = vbNullString

say = Worksheets("VERÝ").Range("A65530").End(3).Row + 1
Worksheets("VERÝ").Range("A" & say) = Worksheets("MUVAFAKAT").Range("K5")
Worksheets("VERÝ").Range("B" & say) = Worksheets("MUVAFAKAT").Range("K4")
Worksheets("VERÝ").Range("C" & say) = Worksheets("MUVAFAKAT").Range("K6")
Worksheets("VERÝ").Range("D" & say) = Worksheets("MUVAFAKAT").Range("A10")
Worksheets("VERÝ").Range("E" & say) = Worksheets("MUVAFAKAT").Range("A14")
Worksheets("VERÝ").Range("F" & say) = Worksheets("MUVAFAKAT").Range("Y18")
Worksheets("VERÝ").Range("G" & say) = Worksheets("MUVAFAKAT").Range("Y19")
Worksheets("VERÝ").Range("H" & say) = Worksheets("MUVAFAKAT").Range("A25")
Worksheets("VERÝ").Range("I" & say) = Worksheets("MUVAFAKAT").Range("C28")
Worksheets("VERÝ").Range("J" & say) = Worksheets("MUVAFAKAT").Range("G41")
Worksheets("VERÝ").Range("K" & say) = Worksheets("MUVAFAKAT").Range("G42")
Worksheets("VERÝ").Range("L" & say) = Worksheets("MUVAFAKAT").Range("G43")
Worksheets("VERÝ").Range("M" & say) = Worksheets("MUVAFAKAT").Range("U43")
Worksheets("VERÝ").Range("N" & say) = Worksheets("MUVAFAKAT").Range("U44")
Worksheets("VERÝ").Range("O" & say) = Worksheets("MUVAFAKAT").Range("U45")
Application.ScreenUpdating = True
Exit Sub

son:
    MsgBox "Mükerrer Kayit", vbCritical, "Mükerrer"

    Erase arr
    kriter1 = vbNullString
    kriter2 = vbNullString
Application.ScreenUpdating = True

End Sub

.rar Muvafakatname.rar (Dosya Boyutu: 97,46 KB | İndirme Sayısı: 3)
Cevapla
#6
Application.ScreenUpdating = True
Bu satır ne işe yarıyor 
Cevapla

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

Yorum yapmak için üye olmanız gerekiyor

ya da
Task