Makro'ya kod eklemek

[leumruk]

Örnek bir dosya ekleyin, onun üzerinde çalışalım.

 

[oLumeleqi]

Örnek bir dosya ekleyin, onun üzerinde çalışalım.

örnek dosya ektedir kardeşim

 

[leumruk]

Örneği deneyiniz.

Sub Makro1()
For x = 1 To [a65536].End(3).Row
    Cells(x, "a").TextToColumns Destination:=Range("c1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, Tab:=True, Comma:=True, TrailingMinusNumbers:=True
    Son = Cells(1, 256).End(1).Column
    Range(Cells(1, "c"), Cells(1, Son)).Sort Key1:=Range("c1"), Orientation:=xlLeftToRight
    For y = 3 To Son
        Cells(x, "b") = Cells(x, "b") & "," & Cells(1, y)
    Next
    Hücre = Mid(Cells(x, "b"), 2, Len(Cells(x, "b")))
    Cells(x, "b") = Hücre
    Range(Cells(1, "c"), Cells(1, Son)).ClearContents
Next
End Sub

 

[oLumeleqi]

Arkadaşım sıralama konusunda teşekkür ederim işe yaradı fazlamı oluyor bilmiyorum ama son bi sorum olucak bi örnek dosya ekledim içerisinde açıklamasıda var

 

[oLumeleqi]

Arkadaşlar makrodaki kodlara ne eklememiz lazım bahsettigim işlemi yapması için bibilginiz yokmu

 

[leumruk]

Arkadaşlar makrodaki kodlara ne eklememiz lazım bahsettigim işlemi yapması için bibilginiz yokmu

Aşağıdaki kodu deneyin. Sanırım istediğiniz budur.

Sub Dene3()
[d1:ı65536].ClearContents
Sat = 1: Sut = 4
x = 1
For i = 1 To 6
s1 = 1: s2 = 2: s3 = 3: s4 = 4: s5 = 5: s6 = 6
Tekrar:
For a = s1 To s1: For b = s2 To s2: For c = s3 To s3: For d = s4 To s4: For e = s5 To s5: For f = s6 To 12
Cells(Sat, Sut) = Cells(x, "a") - Cells(a, "a") + Cells(x, "a")
Sat = Sat + 1
Cells(Sat, Sut) = Cells(x, "a") - Cells(b, "a") + Cells(x, "a")
Sat = Sat + 1
Cells(Sat, Sut) = Cells(x, "a") - Cells(c, "a") + Cells(x, "a")
Sat = Sat + 1
Cells(Sat, Sut) = Cells(x, "a") - Cells(d, "a") + Cells(x, "a")
Sat = Sat + 1
Cells(Sat, Sut) = Cells(x, "a") - Cells(e, "a") + Cells(x, "a")
Sat = Sat + 1
Cells(Sat, Sut) = Cells(x, "a") - Cells(f, "a") + Cells(x, "a")
Sat = Sat + 1
Next: Next: Next: Next: Next: Next
s5 = s5 + 1: s6 = s6 + 1: If s6 = 7 Then GoTo Tekrar
s4 = s4 + 2: If s6 = 8 Then GoTo Tekrar
s4 = s4 - 1: s3 = s3 + 3: If s6 = 9 Then GoTo Tekrar
s3 = s3 - 2: s2 = s2 + 4: If s6 = 10 Then GoTo Tekrar
Sut = Sut + 1
Sat = 1
x = x + 1
Next
End Sub