ptcsite
Altın Üye
- Katılım
- 8 Nisan 2016
- Mesajlar
- 139
- Excel Vers. ve Dili
- M.OFFICE 2021 TR 64 Bit
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
=SIRALA(SÜTUNA(DEVRİK_DÖNÜŞÜM(B2:F17);3);;1)
=SIRALA(FİLTRE(DÜŞEYYIĞ(B2:B17;C2:C17;D2:D17;E2:E17;F2:F17);DÜŞEYYIĞ(B2:B17;C2:C17;D2:D17;E2:E17;F2:F17)<>0);;1)
Public Sub Dene()
Dim rn As Range
Dim i As Long
i = 1
Application.ScreenUpdating = False
Range("A2:A" & Rows.Count).ClearContents
For Each rn In Selection
If Not rn = Empty Then
i = i + 1
Cells(i, "A") = rn.Value
End If
Next rn
Range("A2:A" & i).Sort Key1:=[A1]
Application.ScreenUpdating = True
End Sub
Tablodaki verileri seçtim makro butonu atadım tıkladım çalışmadı... Ama makro penceresinden play e basınca oluyor. Bu nasıl oluyor böyle anlamadım...Merhaba,
Makro ile yapmak isterseniz aşağıdak kodu deneyebilirsiniz.
Önce verileri seçip makroyu çalıştırmanız gerek, veriler A sütununa sıralanacaktır.
Kod:Public Sub Dene() Dim rn As Range Dim i As Long i = 1 Application.ScreenUpdating = False Range("A2:A" & Rows.Count).ClearContents For Each rn In Selection If Not rn = Empty Then i = i + 1 Cells(i, "A") = rn.Value End If Next rn Range("A2:A" & i).Sort Key1:=[A1] Application.ScreenUpdating = True End Sub
Bu kodda alfabetik sıralıyor ayrıca ben kolonları sıra ile dizelesin istemiştim... Yani sırasıyla B-C-D- sütunlarına o sütunu bitirdikten sonra geçsinMerhaba,
Makro ile yapmak isterseniz aşağıdak kodu deneyebilirsiniz.
Önce verileri seçip makroyu çalıştırmanız gerek, veriler A sütununa sıralanacaktır.
Kod:Public Sub Dene() Dim rn As Range Dim i As Long i = 1 Application.ScreenUpdating = False Range("A2:A" & Rows.Count).ClearContents For Each rn In Selection If Not rn = Empty Then i = i + 1 Cells(i, "A") = rn.Value End If Next rn Range("A2:A" & i).Sort Key1:=[A1] Application.ScreenUpdating = True End Sub
Public Sub Listele()
Dim col As Integer
Dim c As Integer
Dim i As Long
Dim j As Long
Application.ScreenUpdating = False
col = Cells(2, Columns.Count).End(1).Column
Range("A2:A" & Rows.Count).ClearContents
For c = 2 To col
j = Cells(Rows.Count, c).End(3).Row
i = Cells(Rows.Count, "A").End(3).Row + 1
Range(Cells(2, c), Cells(j, c)).Copy Range("A" & i)
Next c
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlanmıştır...."
End Sub
Teşekkür ederim peki bunu buton ile çalıştırabilirmiyiz..Merhaba,
Ben sorunuzu tam olarak anlamamışım, aşağıdaki kodları dener misiniz?
Kod:Public Sub Listele() Dim col As Integer Dim c As Integer Dim i As Long Dim j As Long Application.ScreenUpdating = False col = Cells(2, Columns.Count).End(1).Column Range("A2:A" & Rows.Count).ClearContents For c = 2 To col j = Cells(Rows.Count, c).End(3).Row i = Cells(Rows.Count, "A").End(3).Row + 1 Range(Cells(2, c), Cells(j, c)).Copy Range("A" & i) Next c Application.ScreenUpdating = True MsgBox "İşlem Tamamlanmıştır...." End Sub
Valla çok sağolun bu kodu da çalışacağım...Tabiki, bir buton ekleyin ve o butona makro atayın.
Atadığınız makronun adı Listele olmalı.
=TOCOL(TRANSPOSE(B2:F18);1)
=FILTER(FLATTEN(B2:F18);LEN(FLATTEN(B2:F18)))
=QUERY(FLATTEN(TRANSPOSE(B2:F18));"Select * Where Col1 Is Not Null")
Bende biraz Google E-Tablo'lar üzerinde çalıştım..
Alternatifler;
C++:=TOCOL(TRANSPOSE(B2:F18);1)
C++:=FILTER(FLATTEN(B2:F18);LEN(FLATTEN(B2:F18)))
C++:=QUERY(FLATTEN(TRANSPOSE(B2:F18));"Select * Where Col1 Is Not Null")