Verileri 4 e Bölme Makrosu

[ANTALYA 01]

Merhabalar

Ekteki Çalışmada A sütunundaki 102020202050002 Kodun D Sütunundaki ve E Sütunundaki Değerlerini 4'e bölen makroya ihtiyacım var.

 

[Orion1]

Aşağıdaki kod işinizi görür.

Sub bol()
Dim kod As Variant, k As Range, ilk_adr As String
On Error Resume Next
kod = InputBox("Ürün Kodunu Giriniz..:", "4'E BÖLME İŞLEMİ", "102020202050002")
If MsgBox("[ " & kod & " ] Numaralı kodu 4'e Bölmek İstiyormusunuz..!!", _
vbYesNo + vbInformation, "BÖLME") = vbNo Then Exit Sub
If kod = "" Then
    Exit Sub
End If
Set k = Range("A2:A65536").Find(kod, , xlValues, xlWhole, , 1)
If Not k Is Nothing Then
    ilk_adr = k.Address
    Do
        k.Offset(0, 3).Value = k.Offset(0, 3).Value / 4
        k.Offset(0, 4).Value = k.Offset(0, 4).Value / 4
        Set k = Range("A2:A65536").FindNext(k)
    Loop While k.Address <> ilk_adr And Not k Is Nothing
End If
Set k = Nothing
MsgBox "İşlem Tamamlandı..!!"
End Sub

 

[ANTALYA 01]

F

Merhabalar

Tam istediğim gibi kod teşekkür ederim.Yalnız aynı çalışmada şöyle bir makroya daha ihtiyacım var.A sütununda 102030402005003 Kod ile 102030402005002 Kod Aynı Ben Makronun şunu yapmasını istiyorum.Yine bir önceki örneğinizdeki gibi bir pencere açılsın veya değişik bir yolda olabilir.10203002005003 Nolu Kod 06/10/2008 Tarihli olan 500 Adet Silinsin D sütunundan 102030402005002 Nolu Kodun 06/10/2008 Tarihindeki 4692 rakamıyla toplansın 4692+500=5192 Olsun

 

[Orion1]

Konu başlığı ile ilgili sorununuz çözülmüştür.
Yeni konu için yeni bir başlık açıp sorunuzu sorunuz.