Excel - Uzun sütunu boş hücreyle birden çok sütuna bölme

Dolayısıyla, bir zamanlar excel'e içe aktarılan verilere sahibim:

1
2
3
4

A
B
C
D

!
@
#
$

Verilerin şöyle görünmesini istiyorum:

1 A !
2 B @
3 C #
4 D $

Tüm veriler bir sütunda ve her yeni veri kümesi boş bir hücre tarafından dengeleniyor. Tek yapmak istediğim, bir sütunu birden çok sütuna bölerek her boş hücrede yeni bir sütun oluşturabilmek. Verileri her kaydettiğimde, her sette eşit sayıda veri girişi olacak, ancak bunlar aynı tipte değil ve kayıtlar arasında her sette farklı sayıda giriş olabilir. Temelde, olmasını istediğim tek şey excel sütundan aşağı iniyor ve boş bir hücre bulduğunda, kalan tüm verileri bir sonraki sütuna kopyalıyor ve ardından bir sonraki boş hücreyi arar, hangi noktada aynı şeyi yapacak arka arkaya 2 boş hücre olana kadar bir şey.

Bunun nasıl yapıldığını araştırmak son derece sinir bozucu çünkü sütun sonuçlarına metin gönderiyorum, ki istediğim bu değil.

Şimdiden teşekkürler.

Verileri Excel'e almadan önce önişlemenizi öneririm.

Ancak VBA'da istediğinizi yapan bir prosedür hazırladım:

Makroyu yüklemek için

Excel’i Aç - & gt; Alt + F11 - & gt; Ekle - & gt; Modül - & gt; aşağıdaki kodu yapıştırın - & gt; Ctrl + S - & gt; ve açılan listeden 'Excel Makro Etkin Çalışma Kitabı (* .xlsm)' seçeneğini seçin

Sub ToManyColumns()
    Dim firstCellRow As Long
    firstCellRow = 1              'change this if you don't want to start at A1
    Dim firstCellColumn As Long
    firstCellColumn = 1           'change this if you don't want to start at A1

    Application.ScreenUpdating = False
    ActiveSheet.Cells(firstCellRow, firstCellColumn).Activate
    Dim column As Long
    column = firstCellColumn
    Dim startIndex As Long
    Dim endIndex As Long
    Dim lastRow As Long
    lastRow = firstCellRow

    Do While True
        'find the range to copy
        startIndex = ActiveCell.row
        Do While ActiveCell.Value <> ""
            endIndex = ActiveCell.row
            ActiveCell.Offset(1).Activate
        Loop

        lastRow = ActiveCell.row

        Range(Cells(startIndex, firstCellColumn), Cells(endIndex, firstCellColumn)).Select
        Selection.Copy
        Cells(firstCellRow, column).Select
        Selection.PasteSpecial Paste:=xlPasteValues

        'get back to last rowIndex
        Cells(lastRow, firstCellColumn).Activate
        ActiveCell.Offset(1).Activate

        If ActiveCell.Value = "" Then Exit Do

        column = column + 1
    Loop

    'cleanUp -------------------------------------------
    Dim deleteFrom As Long
    Dim deleteTo As Long
    deleteTo = ActiveCell.row

    ActiveSheet.Cells(firstCellRow, firstCellColumn).Activate
    Do While ActiveCell.Value <> ""
        ActiveCell.Offset(1).Activate
    Loop
    deleteFrom = ActiveCell.row

    Range(Cells(deleteFrom, firstCellColumn), Cells(deleteTo, firstCellColumn)).Select
    Selection.ClearContents

    ActiveSheet.Cells(firstCellRow, firstCellColumn).Activate
    'cleanUp -------------------------------------------

    Application.ScreenUpdating = True
End Sub

Makroyu çalıştırmak için:

1. Olmak istediğiniz çalışma sayfasında olduğunuzdan emin olun! Ve çalışma sayfasına herhangi bir yeri tıklayın! (Bu makro, Etkin Çalışma Sayfasında çalıştığı için)
2. Alt + F11 - & gt; Kodun içinde herhangi bir yeri tıklayın - & gt; F5'e basın

Ayrıca çalışma sayfasında bir düğme oluşturabilir ve makroyu atayabilirsiniz - daha kullanıcı dostudur ve doğru çalışma sayfasında olup olmadığınızı kontrol etmeniz gerekmez.

notlar

Makronun A1 hücresinde başlamasını istemiyorsanız (örneğin: farklı sütunda başlar), 3. ve 5. satırlardaki sayıları değiştirin.

Bu amaçla, verileri önceden işlemek makroları kullanmaktan iyidir ...

İlk verinin 1 numaralı A1'de olduğu varsayılmaktadır. yazın :

B1 ---> 1
C1 ---> 1

sonra

B2 ---> =IF(A2="",0,B1+1)
C2 ---> =IF(B2=0,C1+1,C1)

ve verilerin sonuna kadar sürükleyin. Sayfa2'ye A1 hücresi .. yazın:

=IFERROR(INDEX(Sheet1!$A:$A,MATCH(1,INDEX((CELL("row",Sheet2!A1)=Sheet1!$B:$B)*(CELL("col",Sheet2!A1)=Sheet1!$C:$C),0,1),0)),"")

daha sonra C6'ya kadar sürükleyin. Çözüldü.

Umarım yardımcı olur. (:

p / s: Referansım İşte .