MEVCUT LİSTEYİ KOŞULA GÖRE TABLOYA ÇEVİRMEK HK

bkk

Altın Üye
Katılım
30 Aralık 2019
Mesajlar
186
Excel Vers. ve Dili
Ofis 2019
Altın Üyelik Bitiş Tarihi
06-12-2025
Merhabalar ,

Örnek kitapta bulunan listemi yanında bulunan tabloya çevirmek istiyorum ancak bir koşulum var;
Listede "&" karakterini bulursa oluşturacağı tabloda alt satıra geçmesi gerekiyor, bulamazsa yan hücreye yazmaya devam etmelidir,
Konu hakkında yardımlarını rica etmekteyim, teşekkür ederim,

İyi Günler,
 

Ekli dosyalar

DoğanD

Altın Üye
Katılım
22 Eylül 2023
Mesajlar
427
Excel Vers. ve Dili
Office 365 TR
Altın Üyelik Bitiş Tarihi
05-10-2028
Merhaba,

Kodu sayfanın kod kısmına yapıştırıp dener misiniz?

Kod:
Sub DD()
Dim i, sat, sut As Integer
sat = 1
sut = 5
Range("E:H").ClearContents
For i = 2 To Range("B" & [B65536].End(3).Row).Row

If Cells(i, 1) = Chr(38) Then
sat = sat + 1
sut = 5
Else
sut = sut + 1
End If

Cells(sat, sut) = Cells(i, 2)
Next i
End Sub
 
  • Beğen
Reactions: bkk

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,371
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,
İkinci bir seçenek olsun.
Dizilerle çözüm.

Kod:
Sub duzenle()

Dim arr1 As Variant
Dim arr2 As Variant
Dim i As Long
Dim r As Long
Dim c As Integer

arr1 = Range("A2:B" & Cells(Rows.Count, "B").End(3).Row).Value
ReDim arr2(1 To UBound(arr1, 1), 1 To 10)

For i = 1 To UBound(arr1, 1)
    If arr1(i, 1) = "&" Then
        c = 1
        r = r + 1
        arr2(r, c) = arr1(i, 1)
        c = c + 1
        arr2(r, c) = arr1(i, 2)
    Else
        c = c + 1
        arr2(r, c) = arr1(i, 2)
    End If
Next i

Range("D2").Resize(r, 10) = arr2

End Sub
 
  • Beğen
Reactions: bkk

bkk

Altın Üye
Katılım
30 Aralık 2019
Mesajlar
186
Excel Vers. ve Dili
Ofis 2019
Altın Üyelik Bitiş Tarihi
06-12-2025
Dönüşleriniz için çok teşekkür ederim denedim oldu.
 
Üst