alt alta sıralı sayılar

[serseri26]

merhab arkadaşlar
bir sorum daha olacaktı

dekteki excel dosyasında altalta yazılmış sayılar var aralarınta tarihler var ben bunların tarihten itibaren yanyana nasıl yazabilirim
bi yardım edeseniz sevinirim

teşekkürler

 

[Necdet]

Merhaba,

Tesadüfen linke tıkladım, loto sonuçları çıktı. Siteden kopyalayıp excele yapıştırdığımda ilk defa gördüm alt alta yazdı. Sanırım sizde bunun için soruyu sordunuz.

On Numara için

Sub OnNumara()
Dim i, j As Long
Application.ScreenUpdating = False
Range("B:X").Clear
For i = 2 To [A65536].End(3).Row Step 24
    j = i + 22
    Range("A" & i & ":A" & j).Select
    Selection.Copy
    Range("B" & i - 1).PasteSpecial Transpose:=True
    Range("A" & i & ":A" & j).Clear
Next i
Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Cells.Hyperlinks.Delete
Columns("A:A").NumberFormat = "m/d/yyyy"
Columns("A:X").Columns.AutoFit
Range("A2:X" & [A65536].End(3).Row).Sort Key1:=[A1]
Application.ScreenUpdating = True
MsgBox "İşlem Tamamdır..."
End Sub

Süper Loto İçin :
 
Sub SuperLoto()
Dim i, j As Long
Application.ScreenUpdating = False
Range("B:H").Clear
For i = 2 To [A65536].End(3).Row Step 8
    j = i + 6
    Range("A" & i & ":A" & j).Select
    Selection.Copy
    Range("B" & i - 1).PasteSpecial Transpose:=True
    Range("A" & i & ":A" & j).Clear
Next i
Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Cells.Hyperlinks.Delete
Columns("A:A").NumberFormat = "m/d/yyyy"
Range("A2:H" & [A65536].End(3).Row).Sort Key1:=[A1]
Range("A:H").Columns.AutoFit
Application.ScreenUpdating = True
MsgBox "İşlem Tamamdır..."
End Sub

 

[serseri26]

selam aradığım şey buydu teşekkürler
birde bunun sayısal loto olanı için var mı onuda verirsen sevinirim

teşekkürler

 

[Necdet]

Merhaba,

Süper loto ile sayısal arasında fark yok, aynı makroyu kullanabilirsiniz.

Ama isterseniz Şans topunu verebilirim, yapınca onu da aradan çıkartıyım dedim

Sub SansLoto()
Dim i, j As Long
Application.ScreenUpdating = False
Range("B:I").Clear
For i = 2 To [A65536].End(3).Row Step 9
    j = i + 7
    Range("A" & i & ":A" & j).Select
    Selection.Copy
    Range("B" & i - 1).PasteSpecial Transpose:=True
    Range("A" & i & ":A" & j).Clear
Next i
Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Cells.Hyperlinks.Delete
Columns("A:A").NumberFormat = "m/d/yyyy"
Range("A2:I" & [A65536].End(3).Row).Sort Key1:=[A1]
Range("A:I").Columns.AutoFit
Application.ScreenUpdating = True
MsgBox "İşlem Tamamdır..."
End Sub

 

[serseri26]

kardeş evyallah sağolda süper loto macrosunu sayısal lotoya nasıl uyarlıyacam bi göster be

 

[Necdet]

kardeş evyallah sağolda süper loto macrosunu sayısal lotoya nasıl uyarlıyacam bi göster be

Pek kibar konuşuyorsunuz.

 

[serseri26]

kardeş kusura bakla sizi rencide ettiysem özür dilerim

labali konuştum pardon