Makroya ekleme yapma

[arrow3441]

Merhaba üstadlar ekteki dosyada açıklama yaptım yardım ederseniz sevinirim. Teşekkürler

 

[AdemCan]

Merhaba, VBA bölümü şifreli.

 

[arrow3441]

çok özür dilerim düzlettim hocam

 

[arrow3441]

?

 

[veyselemre]

Sub test()
    Dim veri, yVeri, i As Long, say As Long, ii As Byte
    Dim tarihSaat As String
    Sheets("Degisen_Fiyatlar").Cells.ClearContents

    say = 1

    With Sheets("Sql_Stok")
        veri = .Range("A2:D" & .Cells(Rows.Count, 1).End(3).Row).Value
    End With

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

        With Sheets("AlisFiyatlar")
            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) = Round(veri(i, ii), 2)
                ' yVeri(say, ii) = WorksheetFunction.Ceiling(veri(i, ii), 0.5)
                ' End If
                'Next ii
                For ii = 3 To 8
                    If veri(i, ii) <> "" Then
                        yVeri(say, ii) = Round(veri(i, ii), 2)
                    End If
                Next ii
                yVeri(say, 9) = .Item(Trim(veri(i, 1)))(0)
                yVeri(say, 10) = .Item(Trim(veri(i, 1)))(1)

            End If
        Next i
    End With

    If say > 1 Then
        With Sheets("Degisen_Fiyatlar")
            .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("AlisFiyatlar").Range("A1").Resize(1, 10).Value
            .Range("I1") = "BIRIMADI"
            '.Range("J1").Resize(say, 1).NumberFormat = "dd.mm.yyyy HH:mm:ss"
            .Range("J1") = "ACIKLAMA"
        End With
    Else
        MsgBox "Kontrol Edilicek Fiyat Verisi Bulunamadı.", vbExclamation + vbOKOnly, "Uyari"
    End If
End Sub

 

[arrow3441]

Hocam çok teşekkür ederim elinize sağlık