simgeleri belli bir sıraya göre dizme

[mesudiye_052]

Selamlar
örnekte olduğu gibi tek sayıları girince örnekte (7 girildi) aşağıdaki gibi sıralamak istiyorum
1.inputbox'a sayı adedi
2.inputbox'a simge girilince aşağıdaki gbi nasıl yaparız
not :sayı 15 olunca ona göre hücreleri ayarlanacak
Maksat döngüleri daha iyi kavramak;

7 için
			?			
		?	?	?		
	?	?	?	?	?	
?	?	?	?	?	?	?
	?	?	?	?	?	
		?	?	?		
			?

sayı 15 için
							?							
						?	?	?						
					?	?	?	?	?					
				?	?	?	?	?	?	?				
			?	?	?	?	?	?	?	?	?			
		?	?	?	?	?	?	?	?	?	?	?		
	?	?	?	?	?	?	?	?	?	?	?	?	?	
?	?	?	?	?	?	?	?	?	?	?	?	?	?	?
	?	?	?	?	?	?	?	?	?	?	?	?	?	
		?	?	?	?	?	?	?	?	?	?	?		
			?	?	?	?	?	?	?	?	?			
				?	?	?	?	?	?	?				
					?	?	?	?	?					
						?	?	?						
							?

Saygılar;

 

[mesudiye_052]

Selamlar
yardımcı olabilirmisiniz..

Saygılar;

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub DÖNGÜ_İLE_SİMGELERİ_BAKLAVA_DİLİMİ_ŞEKLİNDE_DİZ()
    Dim SAYI As Byte, SİMGE As String, VERİ As Integer
    Dim İLK As Integer, X As Integer, Y As Byte, SAY As Byte
 
    Application.ScreenUpdating = False
 
    Cells.Clear
    Cells.ColumnWidth = 8.43
 
    SAYI = Val(InputBox("Lütfen sayı adedini giriniz !"))
    SİMGE = InputBox("Lütfen dizilecek veriyi giriniz !")
    If SAYI = 0 Or SİMGE = "" Then Exit Sub
 
    VERİ = WorksheetFunction.RoundUp(SAYI / 2, 0)
    İLK = VERİ
    SAY = İLK
 
    For X = 1 To SAYI
        For Y = İLK To SAY
            Cells(X, Y) = SİMGE
        Next
        If X >= VERİ Then
            İLK = İLK + 1
            SAY = SAY - 1
        Else
            İLK = İLK - 1
            SAY = SAY + 1
        End If
    Next
 
    Cells.EntireColumn.AutoFit
 
    Application.ScreenUpdating = True
 
    MsgBox "Baklava şeklinde dizilim işlemi tamamlanmıştır.", vbInformation, "[URL="http://www.excel.web.tr"]www.excel.web.tr[/URL]"
End Sub

 

[Necdet]

Merhaba,

Bir örnekte benden.

Sub Baklava()
On Error Resume Next
Dim Sayı    As Integer
Dim Orta    As Integer
Dim Bas     As Integer
Dim Bit     As Integer
Dim i       As Integer
Dim Simge   As String
Sayı = InputBox("Sayıyı Giriniz", "Sayı Girişi")
If Sayı = 0 Then Exit Sub
Sayı = Application.WorksheetFunction.Odd(Sayı)
Orta = WorksheetFunction.RoundUp(Val(Sayı) / 2, 0)
Simge = InputBox("Simgeyi Giriniz", "Simge Girişi")
If Simge = "" Then Simge = "*"
Application.ScreenUpdating = False
Cells.Clear
Cells.ColumnWidth = 8.43
Bas = Orta + 1
Bit = Orta - 1
For i = 1 To Sayı
    If i > Orta Then
        Bas = Bas + 1
        Bit = Bit - 1
    Else
        Bas = Bas - 1
        Bit = Bit + 1
    End If
    Range(Cells(i, Bas), Cells(i, Bit)) = Simge
Next i
Cells.EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub

 

[mesudiye_052]

Selamlar
Sayın Korhan AYHAN
Sayın Necdet YEŞERTENER
çok teşekkür ederim
sizlerin sayesinde bende bir örnek yapabildim

Sub dilim()
Dim a, b, c, d, i, j, k, l As Integer
a = InputBox("bir sayı giriniz...")
b = InputBox("bir sayı giriniz...")
If a Mod 2 = 0 Then
a = a + 1
End If
c = Int(a / 2) + 1
    For i = 1 To c
        For j = 1 To i + k
        Cells(i, c - i + j) = b
        Cells(a + 1 - i, c - i + j) = b
    Next
    k = k + 1
    Next
End Sub

?
Saygılar;

 

[Korhan Ayhan]

Selamlar,

Kullandığınız kodu denedim. Fakat çift sayılarda baklava diliminin ortasında bir satır fazladan listeleme oluyor.

 

[mesudiye_052]

Selamlar;
Sayın Korhan AYHAN

Kodu düzenledim

Saygılar;