Excelde Bir Soru

  • Konbuyu başlatan Konbuyu başlatan wes
  • Başlangıç tarihi Başlangıç tarihi
Kodla Büyü
wes

wes

Seçkin Üye
Seçkin Üye
Mesajlar
727
Merhabalar.
Excelde şöyle bir tablo oluşturmak istiyorum fakat bir türlü yöntemini bulamadım. Yardım ederseniz sevinirim.

E-okuldan aldığım bir excel verisinde aynı sütun fakat farklı satırlarda almak istediğim veriler mevcut. Mesela A17, A33,A49
Görüldüğü gibi satır sayıları hep 16 artarak gidiyor. Bunlar yeni bir sayfaya sıralı bir şekilde aktarmak istiyorum.
Bunu en basit yöntemle nasıl yapabilirim?
Alınacak veri sayısı çok fazla olduğundan tek tek yazmak baya uzun bir yöntem.

Yardım için şimdiden teşekkürler.
 
aaa.png
 
Teşekkürler. Ben de biraz farklı bir yöntemle PowerQuery ile hallettim.
 
Öğrenci Künye Defterinden veri almak istiyorsanız. Bu kodu kullanabilirsiniz.

Private Sub CommandButton1_Click()

Range("A4:y700").Select
Selection.ClearContents
Dim rr
surucum = ThisWorkbook.Path
dosya = surucum & "\KLASÖRDEKİLERİ BİRLEŞTİRME.xls"
Workbooks.Open Filename:=dosya

Cells(3, "A") = "Okul NO"
Cells(3, "B") = Worksheets("sheet1").Cells(3, "A")
Cells(3, "C") = Worksheets("sheet1").Cells(4, "A")
Cells(3, "D") = Worksheets("sheet1").Cells(5, "A")
Cells(3, "E") = Worksheets("sheet1").Cells(6, "A")
Cells(3, "F") = "DOĞUM YERİ" 'Worksheets("sheet1").Cells(7, "A")
Cells(3, "G") = "DOĞUM TARİHİ"
Cells(3, "H") = Worksheets("sheet1").Cells(9, "A")
Cells(3, "I") = Worksheets("sheet1").Cells(10, "A")
Cells(3, "J") = Worksheets("sheet1").Cells(11, "A")
Cells(3, "K") = Worksheets("sheet1").Cells(12, "A")
Cells(3, "L") = Worksheets("sheet1").Cells(13, "A")
Cells(3, "M") = Worksheets("sheet1").Cells(14, "A")
Cells(3, "N") = Worksheets("sheet1").Cells(15, "A")
Cells(3, "O") = Worksheets("sheet1").Cells(19, "A")
Cells(3, "P") = Worksheets("sheet1").Cells(20, "A")
Cells(3, "R") = Worksheets("sheet1").Cells(18, "A")
Cells(3, "q") = Worksheets("sheet1").Cells(9, "I")
Cells(3, "r") = Worksheets("sheet1").Cells(10, "I")
'Cells(3, "S") = Worksheets("sheet1").Cells(11, "I")

'Cells(sat, "t") = Format(Left(Worksheets("sheet1").Cells(i + 6, "d"), 10))
Cells(3, "s") = Worksheets("sheet1").Cells(11, "I")
'Cells(3, "s") = Worksheets("sheet1").Cells(16, "I")
Cells(3, "t") = Worksheets("sheet1").Cells(22, "a")
Cells(3, "u") = Worksheets("sheet1").Cells(22, "d")
Cells(3, "v") = Worksheets("sheet1").Cells(22, "g")
Cells(3, "w") = Worksheets("sheet1").Cells(22, "j")

sat = 4
For i = 1 To Worksheets("Sheet1").Cells(Rows.Count, "D").End(xlUp).Row Step 22

Cells(sat, "A") = Worksheets("sheet1").Cells(i + 1, "d") ' okul no
'Cells(sat, "AA") = Worksheets("sheet1").Cells(i + 1, "d")
Cells(sat, "B") = Worksheets("sheet1").Cells(i + 2, "d") 'adı
Cells(sat, "C") = Worksheets("sheet1").Cells(i + 3, "d") ' soyadı
Cells(sat, "D") = Worksheets("sheet1").Cells(i + 4, "d") ' baba adı
Cells(sat, "E") = Worksheets("sheet1").Cells(i + 5, "d") ' aNNE ADI
Cells(sat, "F") = Left(Worksheets("sheet1").Cells(i + 6, "d"), InStr(Worksheets("sheet1").Cells(i + 6, "d"), " "))
Cells(sat, "G") = Format((Right(Worksheets("sheet1").Cells(i + 6, "d"), 10)), "dd.mm.yyyy")
Cells(sat, "H") = Worksheets("sheet1").Cells(i + 8, "d") '
'Cells(sat, "E") = Format(Left(Worksheets("sheet1").WorksheetsCells(i + 5, "d"), 10))

Cells(sat, "I") = Worksheets("sheet1").Cells(i + 9, "d")
Cells(sat, "J") = Worksheets("sheet1").Cells(i + 10, "d")
Cells(sat, "K") = Worksheets("sheet1").Cells(i + 11, "d")
Cells(sat, "L") = Worksheets("sheet1").Cells(i + 12, "d")
Cells(sat, "M") = Worksheets("sheet1").Cells(i + 15, "d")
Cells(sat, "N") = Format(Left(Worksheets("sheet1").Cells(i + 16, "d"), 10))
Cells(sat, "O") = Worksheets("sheet1").Cells(i + 18, "d")
'Cells(sat, "O") = Left(Worksheets("sheet1").Cells(i + 18, "d"), InStr(Worksheets("sheet1").Cells(i + 18, "d"), " -"))
Cells(sat, "P") = Worksheets("sheet1").Cells(i + 19, "d")
Cells(sat, "Q") = Worksheets("sheet1").Cells(i + 8, "k")
Cells(sat, "R") = Worksheets("sheet1").Cells(i + 9, "k")
Cells(sat, "S") = Worksheets("sheet1").Cells(i + 10, "k")
'Cells(sat, "s") = Worksheets("sheet1").Cells(i + 15, "k")

'Cells(sat, "t") = Format(Left(Worksheets("sheet1").Cells(i + 6, "d"), 10))

'Cells(sat, "u") = Worksheets("sheet1").Cells(i + 19, "d")
'Cells(sat, "z") = Worksheets("sheet1").Cells(i + 8, "d")
Cells(sat, "t") = Worksheets("sheet1").Cells(i + 22, "b")
Cells(sat, "u") = Worksheets("sheet1").Cells(i + 22, "e")
Cells(sat, "v") = Worksheets("sheet1").Cells(i + 22, "h")
Cells(sat, "w") = Worksheets("sheet1").Cells(i + 22, "k")

sat = sat + 1


'r = r + 22
Next i


For Each w In Workbooks
If w.Name <> ThisWorkbook.Name Then
w.Close savechanges:=True
End If
Next w





End Sub
 
  • Beğen
Tepkiler: wes
Ekran Alıntısı.JPG



Butonun içeriği
sayac = 6


For i = 7 To 100


If Cells(i, 5) <> "" Then
Cells(sayac, 7) = Cells(i, 5).Value
sayac = sayac + 1

End If



Next i
 
  • Beğen
Tepkiler: wes
Başka bir bakış açısı ile makro yazdım.

Sub get_file_data()

Dim s2 As Worksheet
Dim dosya As Variant
Dim titles() As String

Set w1 = ThisWorkbook
Set s1 = w1.Worksheets(1)

With Application.FileDialog(msoFileDialogOpen)
.InitialFileName = ThisWorkbook.Path
.Title = "Dosya Seç"
.ButtonName = "Seç bi şey"
.Filters.Clear
.Filters.Add "Excel Files", "*.xlsx, *.csv, *.xls, *.*xls*"
.FilterIndex = 1

If .Show = 0 Then
Exit Sub
Else
dosya = .SelectedItems(1)
End If
End With

Application.ScreenUpdating = False
Set w2 = Workbooks.Open(dosya)
Set s2 = w2.Worksheets(1)
how_many_students = Int(s2.Cells(Rows.Count, 1).End(xlUp).Row / 22)

s1.Rows("1:5000").Delete Shift:=xlUp
titles = Split("Sıra No,Okul No,Adı,Soyadı,Baba Adı,Anne Adı,Doğum Yeri,Tarihi,T.C. Kimlik No,İli,İlçesi,Mahalle / Köy,Cüz. Kay.No,Yeni Kayıt / Nakil,Get. Öğr. Belgesi,Tarih / Numarası,Veli Adı, Soyadı,Nakil Gelmiş İse Okulu - Tarihi,Cilt No,Aile Sıra No,Sıra No,Ver.Nüfus İdaresi,Veriliş Tarihi,Kabul Ed.Sınıf,Sınavlı/Sınavsız,Yatılı/Gündüzlü,Bursluluk Durumu", ",")

For i = 0 To UBound(titles)
s1.Cells(1, i + 1).Value = titles(i)
Next i

For i = 1 To how_many_students
s1.Cells(i + 1, 1) = i
a = (i - 1) * 22
s1.Cells(i + 1, 1) = i

row_a = 0
coll_a = 0

For x = 2 To 26
If x < 18 Then coll_a = 4 Else coll_a = 11
If x = 8 Then row_a = row_a + 1
If x = 18 Then row_a = row_a - 10
If x = 13 Then row_a = row_a + 1
s1.Cells(i + 1, x) = s2.Cells(a + x + row_a, coll_a)
Nextx

Next i

Application.ScreenUpdating = True
w2.Close

End Sub
 
  • Beğen
Tepkiler: wes
Sıradaki yasak öğrenci künye defterine gelir artık... Adamlar tcli liste isterler ama öyle bir liste yok... Oturup 500 kişiyi bakmamızı isterler... İnternette tüm bilgilerimize ulaşılıyor ama biz eokuldan elimizi altındaki öğrencinin adresine, tcsine ulaşmak için kırk takla atıyoruz...
Uğraştığımız işlere bak, gerçekten üzülüyorum...
 
wes' Alıntı:
Teşekkürler. Ben de biraz farklı bir yöntemle PowerQuery ile hallettim.
Genişletmek için tıkla ...

lazer55' Alıntı:
Öğrenci Künye Defterinden veri almak istiyorsanız. Bu kodu kullanabilirsiniz.

Private Sub CommandButton1_Click()

Range("A4:y700").Select
Selection.ClearContents
Dim rr
surucum = ThisWorkbook.Path
dosya = surucum & "\KLASÖRDEKİLERİ BİRLEŞTİRME.xls"
Workbooks.Open Filename:=dosya

Cells(3, "A") = "Okul NO"
Cells(3, "B") = Worksheets("sheet1").Cells(3, "A")
Cells(3, "C") = Worksheets("sheet1").Cells(4, "A")
Cells(3, "D") = Worksheets("sheet1").Cells(5, "A")
Cells(3, "E") = Worksheets("sheet1").Cells(6, "A")
Cells(3, "F") = "DOĞUM YERİ" 'Worksheets("sheet1").Cells(7, "A")
Cells(3, "G") = "DOĞUM TARİHİ"
Cells(3, "H") = Worksheets("sheet1").Cells(9, "A")
Cells(3, "I") = Worksheets("sheet1").Cells(10, "A")
Cells(3, "J") = Worksheets("sheet1").Cells(11, "A")
Cells(3, "K") = Worksheets("sheet1").Cells(12, "A")
Cells(3, "L") = Worksheets("sheet1").Cells(13, "A")
Cells(3, "M") = Worksheets("sheet1").Cells(14, "A")
Cells(3, "N") = Worksheets("sheet1").Cells(15, "A")
Cells(3, "O") = Worksheets("sheet1").Cells(19, "A")
Cells(3, "P") = Worksheets("sheet1").Cells(20, "A")
Cells(3, "R") = Worksheets("sheet1").Cells(18, "A")
Cells(3, "q") = Worksheets("sheet1").Cells(9, "I")
Cells(3, "r") = Worksheets("sheet1").Cells(10, "I")
'Cells(3, "S") = Worksheets("sheet1").Cells(11, "I")

'Cells(sat, "t") = Format(Left(Worksheets("sheet1").Cells(i + 6, "d"), 10))
Cells(3, "s") = Worksheets("sheet1").Cells(11, "I")
'Cells(3, "s") = Worksheets("sheet1").Cells(16, "I")
Cells(3, "t") = Worksheets("sheet1").Cells(22, "a")
Cells(3, "u") = Worksheets("sheet1").Cells(22, "d")
Cells(3, "v") = Worksheets("sheet1").Cells(22, "g")
Cells(3, "w") = Worksheets("sheet1").Cells(22, "j")

sat = 4
For i = 1 To Worksheets("Sheet1").Cells(Rows.Count, "D").End(xlUp).Row Step 22

Cells(sat, "A") = Worksheets("sheet1").Cells(i + 1, "d") ' okul no
'Cells(sat, "AA") = Worksheets("sheet1").Cells(i + 1, "d")
Cells(sat, "B") = Worksheets("sheet1").Cells(i + 2, "d") 'adı
Cells(sat, "C") = Worksheets("sheet1").Cells(i + 3, "d") ' soyadı
Cells(sat, "D") = Worksheets("sheet1").Cells(i + 4, "d") ' baba adı
Cells(sat, "E") = Worksheets("sheet1").Cells(i + 5, "d") ' aNNE ADI
Cells(sat, "F") = Left(Worksheets("sheet1").Cells(i + 6, "d"), InStr(Worksheets("sheet1").Cells(i + 6, "d"), " "))
Cells(sat, "G") = Format((Right(Worksheets("sheet1").Cells(i + 6, "d"), 10)), "dd.mm.yyyy")
Cells(sat, "H") = Worksheets("sheet1").Cells(i + 8, "d") '
'Cells(sat, "E") = Format(Left(Worksheets("sheet1").WorksheetsCells(i + 5, "d"), 10))

Cells(sat, "I") = Worksheets("sheet1").Cells(i + 9, "d")
Cells(sat, "J") = Worksheets("sheet1").Cells(i + 10, "d")
Cells(sat, "K") = Worksheets("sheet1").Cells(i + 11, "d")
Cells(sat, "L") = Worksheets("sheet1").Cells(i + 12, "d")
Cells(sat, "M") = Worksheets("sheet1").Cells(i + 15, "d")
Cells(sat, "N") = Format(Left(Worksheets("sheet1").Cells(i + 16, "d"), 10))
Cells(sat, "O") = Worksheets("sheet1").Cells(i + 18, "d")
'Cells(sat, "O") = Left(Worksheets("sheet1").Cells(i + 18, "d"), InStr(Worksheets("sheet1").Cells(i + 18, "d"), " -"))
Cells(sat, "P") = Worksheets("sheet1").Cells(i + 19, "d")
Cells(sat, "Q") = Worksheets("sheet1").Cells(i + 8, "k")
Cells(sat, "R") = Worksheets("sheet1").Cells(i + 9, "k")
Cells(sat, "S") = Worksheets("sheet1").Cells(i + 10, "k")
'Cells(sat, "s") = Worksheets("sheet1").Cells(i + 15, "k")

'Cells(sat, "t") = Format(Left(Worksheets("sheet1").Cells(i + 6, "d"), 10))

'Cells(sat, "u") = Worksheets("sheet1").Cells(i + 19, "d")
'Cells(sat, "z") = Worksheets("sheet1").Cells(i + 8, "d")
Cells(sat, "t") = Worksheets("sheet1").Cells(i + 22, "b")
Cells(sat, "u") = Worksheets("sheet1").Cells(i + 22, "e")
Cells(sat, "v") = Worksheets("sheet1").Cells(i + 22, "h")
Cells(sat, "w") = Worksheets("sheet1").Cells(i + 22, "k")

sat = sat + 1


'r = r + 22
Next i


For Each w In Workbooks
If w.Name <> ThisWorkbook.Name Then
w.Close savechanges:=True
End If
Next w





End Sub
Genişletmek için tıkla ...
Hocam bu kodun nasıl kullanılacağını kısaca anlatabilir misiniz?
 
MaviAteş' Alıntı:
PowerQuery ile ilgili deneyiminizi merak ediyorum. Paylaşırsanız, sevinirim.
Genişletmek için tıkla ...

1.png
2.png
3.png
4.png





Arkadaşlar okul işleri sebebiyle biraz geç cevaplayabiliyorum kusura bakmayın.

Ben bu şekilde powerquery kullanarak yaptım.
Filtreleme bölümünde birçok işlem gerçekleştirilebiliyor. İstediğiniz her türlü veriyi oradan ayıklamanız mümkün.
Yardımcı olabildiysem ne mutlu.
 
Cevap yazmak için giriş yap yada kayıt ol.
ilksms
Geri
Üst