• DİKKAT

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

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

  • Konbuyu başlatan Konbuyu başlatan bkk
  • Başlangıç tarihi Başlangıç tarihi

bkk

Katılım
30 Aralık 2019
Mesajlar
186
Excel Vers. ve Dili
Ofis 2019
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

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
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
Dönüşleriniz için çok teşekkür ederim denedim oldu.
 
Geri
Üst