Otomobil Marka SeriModel Veritabanı Çalışması.

[bluebeardx]

Merhabalar,

Daha önce çeşitli uygulamalarda amatör/başlangıç seviyesinde excel formüllerini kullanmıştım. Şu an bir projenin parçası olarak araba marka seri ve modelleriyle ilgili çalışma yapıyorum. Veritabanı Listesi çok uzun, manuel veya formülleri birleştirmeden çalışmak ise çok zor görünüyor. Uygulayabileceğim bir formül için yardımcı olabilirseniz sevinirim.

Şimdiden teşekkürler...

AÇIKLAMA:
Sarı dolgulu olanlar Araç Markası, Mavi dolgulu olanlar Araç Serisi, dolgusuz olanlar ise o seriye ait Araç Modelleridir. Elde etmek istediğim format "Acura CL 2.2" olarak hücreleri birleştirip tüm marka seri modelleri bu formatta aşağıya doğru listelemektir.

 

[mgurten]

Merhabalar,

Daha önce çeşitli uygulamalarda amatör/başlangıç seviyesinde excel formüllerini kullanmıştım. Şu an bir projenin parçası olarak araba marka seri ve modelleriyle ilgili çalışma yapıyorum. Veritabanı Listesi çok uzun, manuel veya formülleri birleştirmeden çalışmak ise çok zor görünüyor. Uygulayabileceğim bir formül için yardımcı olabilirseniz sevinirim.

Şimdiden teşekkürler...

AÇIKLAMA:
Sarı dolgulu olanlar Araç Markası, Mavi dolgulu olanlar Araç Serisi, dolgusuz olanlar ise o seriye ait Araç Modelleridir. Elde etmek istediğim format "Acura CL 2.2" olarak hücreleri birleştirip tüm marka seri modelleri bu formatta aşağıya doğru listelemektir.

Bunları ayrı sütunlara yazma şansınız yokmu?
a sütunu Araç Markası
b sütunu Seri
c sütunu model

bu şekil olursa istediğiniz olabilir ama şu haliyle nasıl yapılır onu bilmiyorum.

 

[bluebeardx]

Tek Tek kesip kopyalamam gerekir ki 200 sayfayı aşkın veri için oldukça zor ve muhtemelen hatalı manuel işlemlerin olabileceği bir iş çıkar diye düşünüyorum.

1 ler ve 0 lar dan yola çıkarak birşeyler yapılabilir belki.

Sağolun.

 

[omerceri]

Sn bluebeardx
Örnek dosyanızdaki renklerle orijinal dosyanızdaki renkler aynı ise aşağıdaki kodlar Verileri H Sütununa aktarıyor.

Sub aktar()
say = Range("a65536").End(3).Row
For i = 1 To say
If Range("a" & i).Interior.ColorIndex = 6 Then Sarı = Trim(Range("a" & i))
If Range("a" & i).Interior.ColorIndex = 8 Then Mavi = Trim(Range("a" & i))
If Range("a" & i).Interior.ColorIndex = -4142 Then
Say2 = Range("H65536").End(3).Row + 1
Range("H" & Say2).Value = Sarı & " " & Mavi & Trim(Range("a" & i))
End If
Next
End Sub

 

[omerceri]

B sütunundaki 0 ve 1 rakamları test ederek te aynı sonuç alına bilinir.

Sub aktar()
say = Range("a65536").End(3).Row
For i = 1 To say
If Range("B" & i) = 1 And Range("B" & i + 1) = 1 Then Sarı = Trim(Range("a" & i))
If Range("B" & i) = 1 And Range("B" & i + 1) = 0 Then Mavi = Trim(Range("a" & i))
If Range("B" & i) = 0 Then
Say2 = Range("H65536").End(3).Row + 1
Range("H" & Say2).Value = Sarı & " " & Mavi & Trim(Range("a" & i))
End If
Next
End Sub

 

[tahsinanarat]

sn. omerceri, güzel kodlar, elinize sağlık. Arşivime ekliyorum.

 

[bluebeardx]

Ömer Bey,

İlginiz ve katkınız için çok teşekkür ederim..

 

[omerceri]

Ayrı hücrelere aktaran kod

Sub aktar()
say = Range("a65536").End(3).Row
For i = 1 To say
If Range("B" & i) = 1 And Range("B" & i + 1) = 1 Then Sarı = Range("a" & i)
If Range("B" & i) = 1 And Range("B" & i + 1) = 0 Then Mavi = Range("a" & i)
If Range("B" & i) = 0 Then
Say2 = Range("H65536").End(3).Row + 1
Range("H" & Say2).Value = Sarı 
Range("I" & Say2).Value = Mavi
Range("J" & Say2).Value =Range("a" & i)
End If
Next
End Sub

 

[bluebeardx]

Ömer Bey,

Sadece son satırdaki 3.0 V6 QV tek hücre olarak çıktı makroyu çalıştırdığımda,.

 

[nane]

omerceri teşekkürler
Yb®

 

[omerceri]

Sizin örnek dosyasında şimdi denedim kodu sorunsuz çalıştı. örnek dosya ekliyorum.

 

[bluebeardx]

Merhaba Ömer Bey,

Çalıştırdım ve sonucu aldım..Çok teşekkür ederim.

 

[hiselamlar]

Teşekkürler.
Daha güncel versiyon mevcutmu acaba?