Excel Vba Forum - Excelce.Net
SORU ve CEVAPLAR (Yazılabilir) => Microsoft Excel, Vba, Makro, Formül vb. Soruları => Çözülen Excel, Vba, Makro, Formül vb. Soruları => Konuyu başlatan: xwyz - 30 Mart 2010, 11:28:30
-
Emrah Çanakkalenin yaptığı benimde düzenlediğim kodda bir problem var. Kod konusuna göre otomatik sektör atıyor. Örneğin konu Parti ise sektörünü otomatik atıyor.
Ancak bazı konularda birden fazla konu var. Şöyleki; "Kum, Taş, Çakıl" gibi. Buna İNŞAAT VE YAPI HİZMETLERİ sektörüne ataması gerekirken "GİYİM" gibi alakasız bir sektör atıyor. Dosya ektedir, ilginize teşekkürler.
[eklenti yönetici tarafından silindi]
-
Merhaba.
Yapılacak işlemi aşama aşama anlatabilir misiniz?
Ona göre çözüm bulmaya çalışalım...
-
Yapılacak işlemi aşama aşama anlatmak gerekirse, "," e kadarki konuyu kaynak alabilir. Bu doğrultuda hangi sektöre girdiğini bulabilir öbür türlü algılamaz zaten.
-
Rowsource sayfasındaki bölüm isimlerini her malzemenin yanına yazsak olmuyormu.İllaki A sütununa bir başlık olacak sonrası olmayacakmı?Böylede olur ama veriler çok olduğu zaman döngüye giriliceğinden işelm uzayabilir.Oysa her malzemenizn yanına hangi katagoride olacağı yazılsa find komutunu kullanarak bir tanesi saniyenin 1/1000 anında bulunular.
-
Dosyanız ektedir.:)
Sub bul_aktar()
Dim sat As Long, i As Long, sh As Worksheet, deg, j As Integer, k As Range
Dim sat2 As Long, sut As Byte, z As Long
Sheets("İşlem").Select
Range("A2:D65536").ClearContents
Application.ScreenUpdating = False
sat = Cells(65536, "E").End(xlUp).Row
Set sh = Sheets("Rawsource")
sat2 = sh.Cells(65536, "B").End(xlUp).Row
For i = 2 To sat
deg = Split(Cells(i, "E").Value, ",")
sut = 0
For j = LBound(deg) To UBound(deg)
Set k = sh.Range("B2:B" & sat2).Find(Trim(deg(j)), , xlValues, xlWhole)
If Not k Is Nothing Then
For z = k.Row To 2 Step -1
If Trim(sh.Cells(z, "A").Value) <> "" Then
sut = sut + 1
Cells(i, sut).Value = sh.Cells(z, "A").Value
Exit For
End If
Next z
End If
Next j
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamamlanmıştır." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub
[Forum yazılım güncelleme esnasında sorun oluştuğundan eklendi silinmiştir.]
-
Hmm mantıklı evet :D Ancak formul ile olmamalı çünkü veriler çok fazla. Düzenledim ve yeni dosyayı söylediğiniz doğrultuda ekledim. Bu arada birden fazla girilmiş konulara virgülden önceki ilk konu baz alınarak sektör atanırsa iyi olur. Kolay gelsin.
[eklenti yönetici tarafından silindi]
-
Ahh ben dediğiniz gibi düzenleyene kadar siz yazmışsınız zaten :D Bu eski kodamı göre?
-
Ben eski kodları sildim.
Hepsini kendim yeniden yazdım.BU kodların içinde eski kodlar yoktur.
İstediğinizi karşıladımı? 8)
-
Elbette. Ama söylediğiniz daha mantıklı gelmişti, bu hali ile fazla veriden problem çıkarmaz diyorsanız çok teşekkür ederim Evren Bey. (=
-
Ben yinede find komutunu kullandım.Önceki kodlarınızda döngü içinde döngü kullanılmıştı.Bu büyük miktarda verilerde uzun çalışırdı.Ben ilk anda find kullandım ondan sonra bulunca döngüye girdim.Buda önceki koda göre 2 kat hızlı çalışır anlamına gelir.8)
Kolay gelsin.
-
sut = sut + 1Bu kodu +4 olarak değiştiriyorum ve istediğim gibi oluyor ancak bir sonraki hücrelere gene sektör taşırıyor, sadece tek sektör getirmesini nasıl sağlayabilirim?
-
Güncel.
-
Aynı satırda bulunan ancak farklı sektörlere ait veriler içerenlerin durumu ne oluyor?
-
Onlar olmasın. Tek Sektör olsun. İlk eklediğim örnekdeki gibi yani.
Tek satırda birden fazla sektör olmasın kısacası tek sektör olsun.
-
İşlem sayfanızın E3 hücresinde şu var: TEMİZLİK MALZEMELERİ, HAVUZ
Ancak,
TEMİZLİK MALZEMELERİ'nin sektörü TEMİZLİK MALZEMELERİ
HAVUZ'un sektörü ise İNŞAAT VE YAPI ÜRÜNLERİ
Bu satırın yanına hangi sektörü yazacağız, onu merak ettim?
-
Evet bunun için virgülden önceki 1. konu alınsın.
TEMİZLİK MALZEMELERİ, HAVUZ
Virgülden önce, Temizlik Malzemeleri mevcut. Bunun sektörüne alınsın.
-
Şu şekilde dener misiniz?
Sub excelce()
On Error Resume Next
For Each aranan In Worksheets("İşlem").Range("E2:E" & Worksheets("İşlem").Range("E65530").End(3).Row)
virgul = VBA.InStr(1, aranan, ",", 0) - 1
If virgul < 1 Then virgul = Len(aranan)
bulunan = VBA.Left(aranan, virgul)
For Each bakilan In Worksheets("Rawsource").Range("B3:B" & Worksheets("Rawsource").Range("B65530").End(3).Row)
If bulunan & "*" Like bakilan & "*" Then
aranan.Offset(0, -1) = bakilan.Offset(0, -1): Exit For
End If
Next bakilan
Next aranan
MsgBox "Bitti.", vbInformation, "Excelce.net"
End Sub
-
Yok olmadı ayrıca Evren beyinkini şöyle düzenleyemezmiyiz, ben denedim ama başaramadım. Şimdi diğer sektörleri bir sonraki hücreye yazıyor. Sadece yazmamasını inaktif etsek yeter yoksa çalışıyor kodu.
-
Yok olmadı
Hiç mi çalışmadı?
Yanlış mı işlem yaptı?
Evren beyinkini şöyle düzenleyemezmiyiz...
Onu Evren Bey daha iyi düzenler. Müsait olmasını bekleyelim isterseniz...
-
Çalıştı ancak %30 bulma oranı ile...
-
Yazım farklılıklarından olabilir mi?
Büyük İ, küçük i falan farklılıkları?..
-
Hayır.
-
İnceler misiniz?
[Forum yazılım güncelleme esnasında sorun oluştuğundan eklendi silinmiştir.]
-
Waaow olmuş :D Teşekkürler 8)
-
Çok şükür. :D
Rica ederim.
Çalışmalarınızda başarılar.