silme işlemi yaptırmak

[XExcel]

mrb,
silme işlemi yaptırmak istiyorum
yardımcı olan arkadaşlara teşekürler ...

 

[usubaykan]

Merhaba,

İstediğiniz değerlere karşılık "X" yazdıran bir makro yazdım umarım yardımcı olur.
Aşağıdaki kodu dener misiniz?

Option Explicit
Sub X_EKLE()
Dim U As Long, Bul As Object, Adres As String
    For U = 2 To Range("IV255").End(xlToLeft).Column
    Set Bul = Range("B6:W65536").Find(What:=Cells(2, U), Lookat:=xlWhole)
        If Not Bul Is Nothing Then
            Adres = Bul.Address
            Do
            Cells(Bul.Row, Bul.Column).Offset(1, 0) = "X"
            Set Bul = Range("B6:W65536").FindNext(Bul)
            Loop While Not Bul Is Nothing And Bul.Address <> Adres
        End If
    Next
End Sub

 

[Orion1]

Açıklamanızdan fazla bir şey anlamdım , ama bir bakın bakalım.

Sub ayir_59()
Dim i As Long, sat As Long, k As Long, col As Collection
Dim say As Byte, j As Byte
Sheets("Sheet3").Select
sat = Cells(65536, "B").End(xlUp).Row
If sat < 6 Then Exit Sub
For i = 6 To sat
    Set col = New Collection
    For k = 2 To 23
        If Cells(i, k).Value <> "" Then
            If WorksheetFunction.CountIf(Range("B2:W2"), Cells(i, k).Value) > 0 Then
                col.Add k
            End If
        End If
    Next
    If col.Count >= 10 Then
        For j = 1 To col.Count
            Cells(i, col(j)).Value = "X"
        Next j
    End If
    Set col = Nothing
Next
MsgBox "İşlem tamamlandı." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[XExcel]

elinize emeğinize sağlık evren hocam çok teşekür ederim kod düzgün çalışıyor yalnız benim anlatamamamdan kaynaklı şoyle bir sorun var!

şu anda "X" leri koşulun gerçekleştiği satırın bir altındaki satıra koyuyor, oysamki "X" işaretlerini şu an olduğu gibi 1 satır altına değilde koşulun gerçekleştiği satıra koymalı.

yani şu anki kodlama düzgün çalışıyor ama tek falsosu koşulun gerçekleştiği satıra değilde 1 satır altındakine "X" işaretlerini koyması bunu düzeltmemiz mümkünmü?

 

[Orion1]

elinize emeğinize sağlık evren hocam çok teşekür ederim kod düzgün çalışıyor yalnız benim anlatamamamdan kaynaklı şoyle bir sorun var!

şu anda "X" leri koşulun gerçekleştiği satırın bir altındaki satıra koyuyor, oysamki "X" işaretlerini şu an olduğu gibi 1 satır altına değilde koşulun gerçekleştiği satıra koymalı.

yani şu anki kodlama düzgün çalışıyor ama tek falsosu koşulun gerçekleştiği satıra değilde 1 satır altındakine "X" işaretlerini koyması bunu düzeltmemiz mümkünmü?

Dosyayı güncelledim.Önceki mesajımdan indirebilirsiniz.

 

[XExcel]

Teşekürler ..

 

[Orion1]

Konuyu tam açıklayamamışsınız.
Hiç bir şey anlamadım.

 

[XExcel]

yeniden açıklamaya çalıştım, umarım bu kez becermişimdir.

 

[Orion1]

Ekteki gibimi?.

Sub aktar_59()
Dim sat4 As Long, sat3 As Long
sat4 = Sheets("Sheet4").Cells(65536, "B").End(xlUp).Row
sat3 = Sheets("Sheet3").Cells(65536, "B").End(xlUp).Row
Application.ScreenUpdating = False
Sheets("Sheet3").Range("B6:W65536").ClearContents
Sheets("Sheet4").Range("B2:W" & sat4).Copy Sheets("Sheet3").Range("B6")
Application.ScreenUpdating = True
Sheets("Sheet3").Select
MsgBox "Veriler Sheet3'e aktarıldı." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[XExcel]

tamamdır güzel olmuş elinize sağlık

 

[Orion1]

Her satır aktarıldığında niye çalışsın ayır makrosu?
Hepsini aktarsın ondan sonra 1 kere çalışsın.İşlem dahada hızlanır.Hatta satır satır değilde komple atalım sheet3 e ondan sonra ayır makrosunu çalıştıralım.Bu dahada işlemi hızlandırır.

 

[XExcel]

hocam bazen bende sizin dediklerinizi anlamıyorum ;-)

 

[Orion1]

hocam bazen bende sizin dediklerinizi anlamıyorum ;-)

Ben sizin söylediğinizi söylüyorum.
O metodla yapmak işlemi yavaşlatır diyorum.
sheet4teki kayıtlı verilerin hepsini kopyalayıp sheet3'e atalım diyorum.
Oysa siz satır satır atalım diyorsunuz.Ve her satırı attıktan sonra önceden yazdığım makroyu çalıştıralım diyoresunuz.
Ben ise sheet4 ten tümünü kopyalayıp sheet3'e atalım.Ondan sonra benim yazdığım makroyu çalıştıralım diyorum.
Böyle yaparsak daha kestirme ve doğru çözüm olur.

 

[XExcel]

hocam haklısınız öle yapalım da benim çekincem şu acaba yaptırmak istediğim işlemi anlatabildimmi ondan emin değilim! yoksam düşünce çok güzel tam bir uzman işi yani dediğniz gibi ayrı ayrı olması önemli değil işlemi çok yavaşlar, dediğiniz şekilde yapmanıza itirazım yok hatta çok iyi olur yalnız sonuçta ne tarz bir işlem yaptırmak istediğimi anlatabildimmi o konuda kendime güvenemiyorum ;-)

 

[Orion1]

hocam haklısınız öle yapalım da benim çekincem şu acaba yaptırmak istediğim işlemi anlatabildimmi ondan emin değilim! yoksam düşünce çok güzel tam bir uzman işi yani dediğniz gibi ayrı ayrı olması önemli değil işlemi çok yavaşlar, dediğiniz şekilde yapmanıza itirazım yok hatta çok iyi olur yalnız sonuçta ne tarz bir işlem yaptırmak istediğimi anlatabildimmi o konuda kendime güvenemiyorum ;-)

9 numaralı mesajdadaki dosyada kopyalama işlemini yaptım.Yani sheet4'ü sheet3'e kopyalama.Önce sheet4 butona basın sonra sheet3'tekiş butona basıp işlemi tamamlayın.