Skip to main content

AccessTr.neT M.


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
Son Düzenleme: 27/02/2020, 17:26, Düzenleyen: HORZUM.
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)
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ş Adlı Kullanıcıdan Alıntı: 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
Son Düzenleme: 02/03/2020, 19:48, Düzenleyen: feraz.

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