• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Makro içerisinde karakter sorunu ve hata?

Katılım
31 Ağustos 2010
Mesajlar
387
Excel Vers. ve Dili
Excel 2007-2010 Eng
Open Office Trk
Selamlar. Sorum buraya yazmaya başladım ama bir türlü cümleyi toparlayamadım. Örnek dosyam içerisinde anlatmak daha mantıklı geldi. Bu yüzden burdan sildim. Bu konu benim için gerçekten çok önemli. Yardımlarınız bekliyorum ve şimdiden çok çok teşekkür ederim.
 

Ekli dosyalar

Dosyanız ektedir.:cool:

Kod:
Sub sirala_59()
Dim col1 As Collection, col2 As Collection
Dim i As Long
Set col1 = New Collection
Set col2 = New Collection
For i = 2 To 10
    If Cells(2, i).Value <> "" And WorksheetFunction.CountIf(Range("H10:O10"), _
    Cells(2, i).Value) = 0 Then
        col1.Add Cells(2, i).Value
        Else
        col2.Add Cells(2, i).Value
    End If
Next i
Range("B2:J2").ClearContents
For i = 1 To col1.Count
    Cells(2, i + 1).Value = col1(i)
Next
If col1.Count > 0 Then
Range(Cells(2, 2), Cells(2, 10)).Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, _
        DataOption1:=xlSortNormal
End If
For i = 1 To col2.Count
    Cells(2, col1.Count + i + 1).Value = col2(i)
Next
Set col1 = Nothing
Set col2 = Nothing

Set col1 = New Collection
Set col2 = New Collection
For i = 8 To 14
    If Cells(4, i).Value <> "" And WorksheetFunction.CountIf(Range("H10:O10"), _
    Cells(4, i).Value) = 0 Then
        col1.Add Cells(4, i).Value
        Else
        col2.Add Cells(4, i).Value
    End If
Next i
Range("H4:N4").ClearContents
For i = 1 To col1.Count
    Cells(4, i + 7).Value = col1(i)
Next
If col1.Count > 0 Then
Range(Cells(4, 8), Cells(4, 14)).Sort Key1:=Range("H4"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, _
        DataOption1:=xlSortNormal
End If
For i = 1 To col2.Count
    Cells(4, col1.Count + i + 7).Value = col2(i)
Next
Set col1 = Nothing
Set col2 = Nothing

MsgBox "işlem tamamdır." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation
End Sub
 

Ekli dosyalar

Teşekkür ederim elinize sağlık ama benim istediğim belki daha basit ama biraz daha farklıydı. Mesela (B2:J2) aralığına harfleri ve karakterleri karışık olarak girdiğimde aynı (B2:J2) aralığında sıralanması. Birde ek olarak (H4:N4) aralığına girdiğim verilerinde aynı kurala uygun aynı anda sıralanmasınıda sağlayabilirmisiniz..

Tekrardan vakit ayırıp emek verdiğiniz için teşekkür ederim.
 
Teşekkür ederim elinize sağlık ama benim istediğim belki daha basit ama biraz daha farklıydı. Mesela (B2:J2) aralığına harfleri ve karakterleri karışık olarak girdiğimde aynı (B2:J2) aralığında sıralanması. Birde ek olarak (H4:N4) aralığına girdiğim verilerinde aynı kurala uygun aynı anda sıralanmasınıda sağlayabilirmisiniz..

Tekrardan vakit ayırıp emek verdiğiniz için teşekkür ederim.

Dosyayı güncelledim.
2 numralı mesajdan indirebilirsiniz.:cool:
 
Tek kelime ile muteşem olmuş. Yaptığınız benim gözümde tam bir sanat harikası. Çok çok teşekkür ederim. Saygılar selamlar....
 
Tek kelime ile muteşem olmuş. Yaptığınız benim gözümde tam bir sanat harikası. Çok çok teşekkür ederim. Saygılar selamlar....
Rica ederim.
Ben bunu hep yapıyorum. :biggrin:
İyi çalışmalar.:cool:
 
Geri
Üst