Ağırlıkların Koliye karşılık gelecek şekilde sıralanması

[ismail-34]

Çok Değerli Excel Web Experlerine selamlar saygılar.

Benim sorum ağırlıkları toplam ağırlığı bir anca bulmak için f sütununa rastgele girdiğimden ötürü oluşan düzensizliği gidermek ile ilgili.

ilerde bazı müşteriler detaylı liste istediğinde kolilerin karşına gelen ağırlıkları tek tek kolinin başladı numaranın başına koyuyorum.

Bu zorluğu ortadan kaldırabilmek üzere yardımlarınızı bekliyorum. Kısaca tıklandığında f sütununun h gibi olması çok işime yarardı.

Örnek ektedir.

Herkese İyi Günler.

 

[DoğanD]

Merhaba,

Anladığım kadarıyla uyguladım, dener misiniz?

Sub dd()
Dim i, t As Integer
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
If Cells(i, 1) = Cells(i - 1, 1) Then
Cells(i, 7) = ""
t = t + 1
Else
Cells(i, 7) = Cells(i - t, 6)
End If
Next i
End Sub

 

[ismail-34]

Merhaba,

Anladığım kadarıyla uyguladım, dener misiniz?

Sub dd()
Dim i, t As Integer
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
If Cells(i, 1) = Cells(i - 1, 1) Then
Cells(i, 7) = ""
t = t + 1
Else
Cells(i, 7) = Cells(i - t, 6)
End If
Next i
End Sub

selam tam doğru çalışmıyor son 2 ağırlığı doğru yerine koymadı yani. bide yeni sütun açıyor tam f sütununun üzerine yeniden yazmasını istiyorum.

 

[ismail-34]

Cevap yok sanırım

 

[Cengiz Demir]

Bu kodları dener misiniz ?

Dim S(99) As Integer
Dim i As Integer
Dim t As Integer

Sub Sirala()

For i = 1 To 99
   
    S(i) = Cells(i + 1, 6)

Next i

Range("F2:F99") = ""

t = 1

For i = 2 To 99

    If Cells(i, 1) = t Then Cells(i, 6) = S(t): t = t + 1
    If S(t) = 0 Then Exit For

Next i

End Sub

 

[ismail-34]

Bu kodları dener misiniz ?

im S(99) As Integer
Dim i As Integer
Dim t As Integer

Sub Sirala()

For i = 1 To 99
   
    S(i) = Cells(i + 1, 6)

Next i

Range("F2:F99") = ""

t = 1

For i = 2 To 99

    If Cells(i, 1) = t Then Cells(i, 6) = S(t): t = t + 1
    If S(t) = 0 Then Exit For

Next i

End Sub

ekteki hatayı veriyor malesef.excel versiyon farkımı ? 2013 türkçe office bendeki.

 

[Cengiz Demir]

Kusura bakmayın kopyalarken ilk sıradaki Dim'in D si gitmiş
im i Dim olarak değiştirirseniz sorun çıkmaz

ekteki hatayı veriyor malesef.excel versiyon farkımı ? 2013 türkçe office bendeki.

 

[ismail-34]

eyw hocam sub siralada en üstte olcakmış. kodun son halini aşağıda paylaşıyorum. çok işime yaradı sağolun varolun

Sub agirlik_sirala()

Dim S(500) As Integer
Dim i As Integer
Dim t As Integer



For i = 1 To 500

S(i) = Cells(i + 1, 6)

Next i

Range("F2:F500") = ""

t = 1

For i = 2 To 500

If Cells(i, 1) = t Then Cells(i, 6) = S(t): t = t + 1
If S(t) = 0 Then Exit For

Next i

End Sub

 

[Cengiz Demir]

Rica ederim

eyw hocam sub siralada en üstte olcakmış. kodun son halini aşağıda paylaşıyorum. çok işime yaradı sağolun varolun