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

[arrow3441]

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

 

[Necdet]

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.

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

 

[arrow3441]

Teşekkür ederim hocam 2 dk oldu hala çalışmakta çok yavaş. Günde bu işlemi 10 kere yapmam gerekicek

 

[Necdet]

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.

 

[arrow3441]

Değerli yorumlarınız için teşekkür ederim bende merakla bekliyorum hocam

 

[veyselemre]

Rapor sayfası oluşturun.
Kod 13 nolu mesajda düzenlendi.

 

[arrow3441]

hocam süper olmuş elinize sağlık

 

[arrow3441]

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

 

[veyselemre]

Kod 13 nolu mesajda düzenlendi.

 

[arrow3441]

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

 

[veyselemre]

Dosyanızı ekler misiniz?

 

[arrow3441]

buyrun hocam kaymada yapıyor bu arada dikkat ederseniz

8688890003741 bu barkod fiyat yok ama yazmış

 

[veyselemre]

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

 

[arrow3441]

Çok teşekkür ederim hocam oldu ama sadece başlıkları getirmedi

 

[veyselemre]

Yukarıdaki koda başlık eklendi.

 

[arrow3441]

Çok özür dileyerek hocam 2 adet bilgi var mesela 1 adetini getiriyor . Dosyayı ekledim çok zahmet verdim biliyorum ama

 

[veyselemre]

11 nolu kod düzenlendi

 

[arrow3441]

Elinize kolunuza sağlık çok teşekkür ederim hocam mükemmel oldu

 

[arrow3441]

Hocam merhaba tekrardan fiyatları aktarmıyor. Sanırım stokkodundan dolayı anlamadım. Sql_stok kısmından kopyala yapıştır yaparsam buluyor.

 

[veyselemre]

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

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