sıralama yaparken hücre rekleri değişmesi sorunu

[mavidus]

arkadaşlar sıralama yaptırdığım zaman hüzrelere verdiğim rekleride sıralama ile birlikte taşıdığı içn çirkin bir görüntü oluşuyor.Bunu gidermenin bir yolu varmı.?sıralama komutum aşağıdaki gibi
[a14:h6000].Sort Key1:=[A14]

 

[Ali]

Aşağıdaki link belki işinizi görebilir.

http://www.ozgrid.com/VBA/Sort.htm

 

[mavidus]

teşekürler fructose
ben bu kodları sayfama ekledim ama yapamadım sen yapabildinmi acaba

 

[Ali]

Hayır denemedim ama bunu anlatan sitelere yönelendirebilirim. Sıralama ile birlikte taşırken çirkin oluyor demişsiniz. Karşındaki renk ne ise o na göre sıralayacak. Sizin probleminiz sanırım renkler değişmesin yani form bozulmasın ama renkli şablon içindeki değerler sıralansın öylemidir. Doğru anlamışmıyım
Aşağıdaki linke bir bakın.Ben deneyeyim yaparsam örnek bir çalışma eklerim

http://www.digdb.com/excel_add_ins/sort_custom_text_length_color/

 

[excelvba]

Þöyle bir öneride bulunuyorum. Ã?rneğin sıralayacağınız tabloyu önce başka bir sayfaya kopyalayın ve burada sıralayın. Sonra bu sayfadan sıralanmış verileri kopyalayarak sadece verileri asıl sayfaya yapıştırın. Bunun için aşağıdaki gibi bir örnek kodu deneyebilirsiniz. Verilerinizin sayfa1 de olduğu kabul edilmiştir.

[vb:1:5f1f010658]Sub sirala()
Application.ScreenUpdating = False
Set s1 = Sheets("sayfa1")
Set s2 = Sheets("sayfa2")
s1.[a14:h6000].Copy
s2.[a1].PasteSpecial Paste:=xlValues
s2.[a1:h6000].Sort Key1:=s2.[a1]
s2.[a1:h6000].Copy
s1.[a14].PasteSpecial Paste:=xlValues
s1.[a14:h6000].Sort Key1:=s1.[a14]
Application.CutCopyMode = False
s1.[a1].Select
s2.[a:h].ClearContents
End Sub[/vb:1:5f1f010658]

 

[mavidus]

çok teşekkürler excel vba benim de ilk aklıma o geldi ama sayfalar çok fazla ve coboboxlar var onların değerleri felan da taşınıyor.verdiğin siteyi kontrol edecem.

 

[Ali]

Sayın mavidus aşağıdaki kodu Module içine yapıştırın.

Function ColorIndexOfCell(Rng As Range, _
Optional OfText As Boolean, _
Optional DefaultAsIndex As Boolean = True) As Integer

Dim C As Long
If OfText = True Then
C = Rng.Font.ColorIndex
Else
C = Rng.Interior.ColorIndex
End If

If (C < 0) And (DefaultAsIndex = True) Then
If OfText = True Then
C = GetBlack(Rng.Worksheet.Parent)
Else
C = GetWhite(Rng.Worksheet.Parent)
End If
End If

ColorIndexOfCell = C

End Function


Function GetWhite(WB As Workbook) As Long
Dim Ndx As Long
For Ndx = 1 To 56
If WB.Colors(Ndx) = &HFFFFFF Then
GetWhite = Ndx
Exit Function
End If
Next Ndx
GetWhite = 0
End Function

Function GetBlack(WB As Workbook) As Long
Dim Ndx As Long
For Ndx = 1 To 56
If WB.Colors(Ndx) = 0& Then
GetBlack = Ndx
Exit Function
End If
Next Ndx
GetBlack = 0
End Function

Formüller altında ColorIndexOfCell fonksiyonu görülecek

Eğer Background rengine göre sıralamak istiyorsanız aşağıdaki formülü kullanınız

=ColorIndexOfCell(A1,FALSE,TRUE)

Eğer font rengine göre sıralamak istiyorsanız aşağıdaki formülü kullanınız

=ColorIndexOfCell(A1,TRUE,TRUE)

İngilizce bir kaynaktan çevirdim.Deneme fırsatım olmadı siz bir bakın