• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Karşılaştırma olmayan satırları silme

A

arrow3441

Altın Üye
Katılım
31 Ekim 2022
Mesajlar
297
Excel Vers. ve Dili
2016
Merhabalar herkese ekteki dosyada Fiyatdeğişimşablonu ve sql_stok sayfalarım bulunmaktadır.
Yapmak istediğim Fiyatdeğişimşablonu ve sql_stok sayfalarındaki stokkodlarını karşılaştırarak sql_stok sayfasında olmayan ürünlerin Fiyatdeğişimşablondaki satırları silmesi ve sql_stok sayfasında bulunan kayıtların BIRIMADI nın Fiyatdeğişimşablonu ndaki BIRIM alanındaki ilgile yere yazması örnek dosyada sarı ile işaretleme yaptım onlar sql_stok sayfasında yoktur. Bİrde değerli üstadlar fiyat alanında virgülden sonra 2 hane kalıcak şekilde düzeltme olabilirmi teşekkür ederim şimdiden
 

Ekli dosyalar

Merhaba,

Dosyanızın yedeğini aldıktan sonra aşağıdaki kodları bir modüle kopyalayıp deneyiniz.
Sql verileriniz fazla olduğundan kodların çalışması zaman alacaktır.

Not : kodda sayfa isimlerini değil, sayfa indisini kullandım.
Yani : "Fiyat_Degisim_Sablonu" için Sheets("Fiyat_Degisim_Sablonu") değil, Sayfa1 dedim kodda.


245720
Kod: 
Public Sub Bul()

Dim i   As Long, _
    j   As Integer, _
    adt As Long, _
    c   As Range, _
    rng As Range

Application.ScreenUpdating = False

Set rng = Sayfa1.Range("A1").CurrentRegion

For i = rng.Count To 2 Step -1
    Set c = Sayfa2.Range("A:A").Find(rng(i, 1), LookIn:=xlValues, LookAt:=xlWhole)
    If Not c Is Nothing Then
        For j = 3 To 8
            If Not rng(i, j) = "" And IsNumeric(rng(i, j)) Then rng(i, j) = Round(rng(i, j), 2)
        Next j
    Else
        adt = adt + 1
        rng.Rows(i).Delete
    End If
Next i

Application.ScreenUpdating = True

If adt > 0 Then
    MsgBox adt & " Adet Kayıt Bulunmadı ve Silindi...."
Else
    MsgBox "Tüm kayıtlar bulundu ve Düzeltildi..."
End If

End Sub
 
Teşekkür ederim hocam 2 dk oldu hala çalışmakta çok yavaş. Günde bu işlemi 10 kere yapmam gerekicek
 
Evet her iki sayfa da baya çok satır içeriyorsa zaman alması doğal.
Dizilere aktarıp hızlandırılabilinir mi üzerinde çalışmak gerek.
Bakalım farklı önerisi olan varsa bende merak ediyorum. Aklımda bir şeyler uçuşuyor ama şu an için zamanım yok.
sql verileri belki sıralı olsa hızlanır mı diye merak ediyorum. Denemek gerek.
 
Değerli yorumlarınız için teşekkür ederim bende merakla bekliyorum hocam
 
Rapor sayfası oluşturun.
Kod 13 nolu mesajda düzenlendi.
 
Son düzenleme:
hocam son bir şey daha istesem onu gözden kaçırmışım CDE sütunlar yukarı yuvarla olucak yani 75,45 ise 75,50 gibi 0.5 yuvaralam diğer FGH sütunlar virgülden sonra 2 hane kalıcak olurmu acaba
 
Kod: 
Kod 13 nolu mesajda düzenlendi.
 
Son düzenleme:
teşekkür ederim hocam denedim şimdi
alttaki barkodlarn sat1 23,10 yazdım 8490 olan 23,50 yazdı diğerine 23,10

8680096088490

8680096102981

 
buyrun hocam kaymada yapıyor bu arada dikkat ederseniz

8688890003741 bu barkod fiyat yok ama yazmış
 

Ekli dosyalar

Kod: 
Sub test()
    Dim veri, i&, say&, ii As Byte
    say = 1
    With Sheets("Sql_Stok")
        veri = .Range("A2:C" & .Cells(Rows.Count, 1).End(3).Row).Value
    End With

    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(veri)
            .Item(veri(i, 1)) = veri(i, 3)
        Next i

        With Sheets("Fiyat_Degisim_Sablonu")
            veri = .Range("A1:J" & .Cells(Rows.Count, 1).End(3).Row).Value
        End With
        ReDim yVeri(1 To UBound(veri), 1 To UBound(veri, 2))
        For i = LBound(veri) To UBound(veri)
            If .exists(veri(i, 1)) Then
                say = say + 1
                yVeri(say, 1) = veri(i, 1)
                yVeri(say, 2) = veri(i, 2)
                For ii = 3 To 5
                    If veri(i, ii) <> "" Then
                        yVeri(say, ii) = WorksheetFunction.Ceiling(veri(i, ii), 0.05)
                        'yveri(say, ii) = WorksheetFunction.MRound(veri(i, ii), 0.05)
                    End If
                Next ii
                For ii = 6 To 8
                    If veri(i, ii) <> "" Then
                        yVeri(say, ii) = Round(veri(i, ii), 2)
                    End If
                Next ii
                yVeri(say, 9) = .Item(veri(i, 1))
            End If
        Next i
    End With

    If say > 1 Then
        With Sheets("Rapor")
            .Cells.ClearContents
            .Range("A1").Resize(say, 1).NumberFormat = "@"
            .Range("C2:H2").Resize(say - 1).NumberFormat = "#,##0.00"
            .Range("A1").Resize(say, 10).Value = yVeri
            .Range("A1").Resize(1, 10).Value = Sheets("Fiyat_Degisim_Sablonu").Range("A1").Resize(1, 10).Value
            .Range("A1").CurrentRegion.EntireColumn.AutoFit
        End With
    End If
End Sub
 
Son düzenleme:
Çok teşekkür ederim hocam oldu ama sadece başlıkları getirmedi
 
Çok özür dileyerek hocam 2 adet bilgi var mesela 1 adetini getiriyor . Dosyayı ekledim çok zahmet verdim biliyorum ama
 

Ekli dosyalar

Elinize kolunuza sağlık çok teşekkür ederim hocam mükemmel oldu
 
Hocam merhaba tekrardan fiyatları aktarmıyor. Sanırım stokkodundan dolayı anlamadım. Sql_stok kısmından kopyala yapıştır yaparsam buluyor.
 

Ekli dosyalar

Sayfalardaki stok kodlarının hücre formatları farklı (Number<>General)

Kod: 
Sub test()
    Dim veri, i&, say&, ii As Byte
    say = 1
    With Sheets("Sql_Stok")
        veri = .Range("A2:C" & .Cells(Rows.Count, 1).End(3).Row).Value
    End With

    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(veri)
            .Item(veri(i, 1)) = Trim(veri(i, 3))
        Next i

        With Sheets("Fiyat_Degisim_Sablonu")
            veri = .Range("A1:J" & .Cells(Rows.Count, 1).End(3).Row).Value
        End With
        ReDim yVeri(1 To UBound(veri), 1 To UBound(veri, 2))
        For i = LBound(veri) To UBound(veri)
            If .exists(Trim(veri(i, 1))) Then
                say = say + 1
                yVeri(say, 1) = Trim(veri(i, 1))
                yVeri(say, 2) = veri(i, 2)
                For ii = 3 To 5
                    If veri(i, ii) <> "" Then
                        yVeri(say, ii) = WorksheetFunction.Ceiling(veri(i, ii), 0.05)
                        'yveri(say, ii) = WorksheetFunction.MRound(veri(i, ii), 0.05)
                    End If
                Next ii
                For ii = 6 To 8
                    If veri(i, ii) <> "" Then
                        yVeri(say, ii) = Round(veri(i, ii), 2)
                    End If
                Next ii
                yVeri(say, 9) = .Item(veri(i, 1))
            End If
        Next i
    End With

    If say > 1 Then
        With Sheets("Rapor")
            .Cells.ClearContents
            .Range("A1").Resize(say, 1).NumberFormat = "@"
            .Range("C2:H2").Resize(say - 1).NumberFormat = "#,##0.00"
            .Range("A1").Resize(say, 10).Value = yVeri
            .Range("A1").Resize(1, 10).Value = Sheets("Fiyat_Degisim_Sablonu").Range("A1").Resize(1, 10).Value
            .Range("A1").CurrentRegion.EntireColumn.AutoFit
        End With
    End If
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst