makroyu 9000 satır olan E sütununa uygulama??

[yyhasan]

Aşağıdaki makroyu nasıl E1 ile E900 arasına uygulayabilirim.??


Dim ExcelLastCell As Object, lRow As Long, lLastDataRow As Long, l As Long
Dim TempStr As String

Set ExcelLastCell = Sheets("cihaz").Cells.SpecialCells(xlLastCell)
lLastDataRow = ExcelLastCell.Row
lRow = ExcelLastCell.Row
TempStr = ""

urun = ActiveCell.Value
mevcutsatir = ActiveCell.Row
'parça adı bulunması
For i = 1 To lRow
If UCase(Sheets("cihaz").Range("E" + CStr(i)).Value) = UCase(urun) Then
TempStr = TempStr & Sheets("cihaz").Cells(i, 6).Value & ","
End If

DoEvents
Next
'alınan bilgilerin sayfaya yazdırılması
Cells(mevcutsatir, 4).Value = TempStr

End Sub

 

[Korhan Ayhan]

Selamlar,

Örnek dosya ekleyerek yapmak istediğiniz işlemi açıklarmısınız.

 

[yyhasan]

Makrolu dosyayı ekledim.

 

[yyhasan]

"ypliste"sayfası
A B C D E
Sıra No Eşleşme Kodu AÇIKLAMA Cihaz Kodu
DEFTER, 123456
KALEM, 1234567
SİLĞİ, 12345678




"cihaz" sayfası
A B C D E F
Sıra No Eşleşme Kodu Cihaz Kodu AÇIKLAMA
123456 DEFTER
1234567 KALEM
12345678 SİLĞİ

 

[yyhasan]

dosyayı ekleyemedim.
boyutu 550 kb olduğu için.

 

[Korhan Ayhan]

Selamlar,

Sıkıştırma programlarını kullanarak dosyanızı sıkıştırıp foruma ekleyebilirsiniz.