Çözüldü For Next Döngü İsteği

[cavanoos]

Merhaba arkadaşlar;

Ekli dosyamda fatura numarası değiştikçe döngü yapmaya çalışıyorum.
Aynı fatura numarası varsa döngü çalışmasın, farklı olursa çalışsın.
C2 seçili hücre iken aşağıdaki komutlar çalışacak. Sonra bitene kadar devam edecek.
Yardımcı olur musunuz ?

ActiveCell.Offset(0, 1).Select
ActiveCell.Offset(0, 0).Value = ActiveCell.Offset(0, -1).Value / 1.2
ActiveCell.Offset(0, 1).Select
ActiveCell.Offset(0, 0).Value = ActiveCell.Offset(0, -1).Value * 0.2

 

[muygun]

Merhaba;
Kodlarınızdan bir anlam çıkaramadım ama;

Sub Makro1()
sonn = Range("b65536").End(xlUp).Row
For k = 2 To Range("b65536").End(xlUp).Row
If WorksheetFunction.CountIf(Range("b2:b" & k), Cells(k, "b")) = 1 Then

Cells(k, "d") = Cells(k, "c") * 0.8
Cells(k, "e") = Cells(k, "c") * 0.2

End If
Next k
End Sub

Kodlarını yerleştirip deneme yapın.
Burada;
If WorksheetFunction.CountIf(Range("b2:b" & k), Cells(k, "b")) = 1 Then
ile ilk fatura nosuna işlem yapar
Bunu içinde bir tane varsa gibi değitirebilirsiniz.
Not: Toplam içerisinden %80 ve %20 yazdırdım. İşlemi kendinize göre düzenleyin.
İyi çalışmalar.

 

[cavanoos]

Muygun;

İlginiz için teşekkür ederim. Kodunuz çalıştı ama istediğim sonuca erişemedim.
Şöyle ki;
Alttaki kendi yazdığım kod satırı deneme amaçlı, asıl kod daha uzun olacak.
Döngü kod mantığı kurulduktan sonra asıl kodu yerleştiririm diye düşündüm ama deneme amaçlı da olmadı.
Olması gereken C2 hücresinde aşağıdaki deneme amaçlı kod çalıştıktan sonra, C3 te aynısını yapacak, sonra C5 de.

Sub Makro2()
sonn = Range("b65536").End(xlUp).Row
For k = 2 To Range("b65536").End(xlUp).Row
If WorksheetFunction.CountIf(Range("b2:b" & k), Cells(k, "b")) = 1 Then

ActiveCell.Offset(0, 1).Select
ActiveCell.Offset(0, 0).Value = ActiveCell.Offset(0, -1).Value / 1.2
ActiveCell.Offset(0, 1).Select
ActiveCell.Offset(0, 0).Value = ActiveCell.Offset(0, -1).Value * 0.2

End If
Next k
End Sub

 

[dost]

Merhaba,

Sub Test()
Dim i, lRow As Long

lRow = Cells(Rows.Count, "B").End(3).Row

For i = 2 To lRow
    If WorksheetFunction.CountIf(Range("B2:B" & i), Cells(i, "B")) = 1 Then
        Cells(i, "D") = Cells(i, "C") / 1.2
        Cells(i, "E") = Cells(i, "C") * 0.2
    End If
Next i

MsgBox "İşlem tamam..."

End Sub

Scripting.Dictionary ile (daha hızlı);

Sub Test2()
Dim i, lRow, say As Long
Dim myData As Variant
Dim myArr As Object


lRow = Cells(Rows.Count, "B").End(3).Row
myData = Range("B2:C" & lRow).Value

Set myArr = CreateObject("Scripting.Dictionary")

ReDim myList(1 To lRow, 1 To 2)

For i = LBound(myData) To UBound(myData)
    say = say + 1
    If Not myArr.Exists(myData(i, 1)) Then
        myArr.Add myData(i, 1), say
        myList(say, 1) = myData(i, 2) / 1.2
        myList(say, 2) = myData(i, 2) * 0.2
    End If
Next i

Range("D2").Resize(say, 2) = myList

Set myArr = Nothing

MsgBox "İşlem tamam..."

End Sub

 

[cavanoos]

Dost;

Kodunuzu denedim, çalıştı ama asıl dosyama uyarlayamadım.
Ekte asıl dosyamı paylaşıyorum.
E2 hücresi seçili iken başlat adındaki makromu çalıştırıyorum.
Bu kodu her yeni fatura satırında çalıştırıyorum, çalışıyor.

Her satırda bu kodu seçmek yerine, bunu nasıl döngüye tabi tutarız, bir kere basalım ve sonuna kadar gitsin.
Bunu çözmeye çalışıyorum, ama yazdığınız kodları kendime göre uyarlayamıyorum.

 

[dost]

Merhaba,

Dosyanızı harici link olarak paylaşır mısınız.

 

[cavanoos]

İndir Telefon Faturalarını İşleme xlsm

Dosyayı indir Telefon Faturalarını İşleme xlsm

dosya.co

 

[dost]

Merhaba,

Paylaştığınız makro kodunu unutun.

Sizin yapmak istediğiniz nedir?

Benim anladığım:
B sütunundaki fatura nolarına göre (aynı faturalardan sadece biri dikkate alınmak şartıyla);
C sütunundaki tutarın içindeki
- KDV tutarını E sütununa
- ÖİV tutarını F sütununa

makro ile yazdırmak istiyorsunuz.

C sütunundaki tutarların içinde % 20 KDV + % 10 ÖİV mevcuttur. KDV ve ÖİV tutarları bu orana göre hesaplanacaktır.

Bu yazdıklarımdan başkaca bir şey istemiyorsunuz.

Doğru mu anlamışım?

 

[cavanoos]

İlginiz için teşekkür ederim, saolun.
Kdv dahil telefon faturasının matrahını, kdvsini, öivsini ayrıştırıyorum.
Lakin bu işte biraz karışık. Bunun içinde eğer kullanıyorum.
Kod çalışıyor.

Dediğim gibi her satırda seçili E hücresinde makro kodumu çalıştıracağıma, bunu bir döngüye tabii tutup, kodu tek seferde başlatıp, bütün fatura numaralarına işlem yaptırmak istiyorum.
Mevcut koda, döngü kodlarını ekleyebilirsek işlem tamam.
Olmuyorsa da saolun, bu kadar ilgilenmeniz bile kafi

 

[dost]

Merhaba,

Aşağıdaki kodu Module1 sayfasına yapıştır.

Daha sonra çalıştırırsın.

Sub Test2()
Dim i, lRow, say As Long
Dim myData As Variant
Dim myArr As Object
Dim oiv, kdv As Double


lRow = Cells(Rows.Count, "B").End(3).Row
myData = Range("B2:C" & lRow).Value

Set myArr = CreateObject("Scripting.Dictionary")

ReDim myList(1 To lRow, 1 To 2)

oiv = 10
kdv = 20

For i = LBound(myData) To UBound(myData)
    say = say + 1
    matrah = 0
    If Not myArr.Exists(myData(i, 1)) Then
        matrah = VBA.Round(myData(i, 2) / (1 + ((oiv + kdv) / 100)), 2)
        myArr.Add myData(i, 1), say
        myList(say, 1) = VBA.Round((matrah * kdv / 100), 2)
        myList(say, 2) = VBA.Round((matrah * oiv / 100), 2)
    End If
Next i

Range("E2").Resize(say, 2) = myList

Set myArr = Nothing

MsgBox "İşlem tamam..."

End Sub

 

[cavanoos]

Dost;

Bu şekilde sonuca ulaşamayız, yazdıklarımı dikkate almıyorsunuz. Konu benim için kapanmıştır.
İlginiz için tekrar teşekkür ederim.

 

[dost]

Dost;

Bu şekilde sonuca ulaşamayız, yazdıklarımı dikkate almıyorsunuz. Konu benim için kapanmıştır.
İlginiz için tekrar teşekkür ederim.

cavanoos,

Keşke anlayabileceğim şekilde anlatabilseydiniz !
Neyse konu benim için de kapanmıştır.

Moderatör konuyu kilitleyebilirse memnun olurum.

 

[cavanoos]

Sorunum çözüldü.
Belki başkasına da faydası olur diye yazıyorum.

Kendi kod satırımın başına alttaki kodu ekledim.

For i = 2 To (Cells(Rows.Count, 2).End(3).Row - 1) * 3
If Cells(i, 2) <> Cells(i - 1, 2) And Cells(i, 2) <> "" Then
Cells(i, 5).Select

Kod satır bloğum

Bitiminde de aşağıdaki kodu ekledim.

End If
Next