Range("A:A").Find(aranan).Select

[TiOr]

Merhaba, Sn. İlgili;

Aşağıdaki kodlar ile kaydet, bul, sil, değiştir, yazdır kriterleri çerçevesinde bir userform oluşturdum.
Gayette güzel çalışıyor.
Fakat tek sorunum bul kısmında mükerrer kayıtların ilk satırını getiriyor. Mükerrer kayıtları şöyle izah edeyim; yüzlerde, binlerce ürün düşünün ve her birinin hatası farklı veya aynı ve bu hatalı ürünleri üretim kısmında ki ilgililer numune görmek istiyor ve aynı modelin farklı hatalarından talep ediyorlar veya aynı hatalarından renkleri farklı vs.. durum böyle olunca özel kod kısmında aramayı yaptırıyorum ürün buldukça fakat dediğim gibi ilk kaydı buluyor fakat sonraki kayıtları getirmiyor. Kodlama kısmında yardımcı olabilir misiniz?

Desteklerinizi talep eder, iyi çalışmalar dilerim.
Saygılarımla,
Orhan ÇOLAK

Bul kısmının kodlaması aşağıdaki gibidir; (Kodlamanın tamamı ileti devamında "Kod Başlangıç;" itibari ile başlamaktadır)

Private Sub CommandButton2_Click()

On Error GoTo Bitir
aranan = InputBox("Aramak istediğiniz 8 Haneli Özel Kod değerini giriniz", "Arama Yap", " ")
Range("A:A").Find(aranan).Select
sil_satır = ActiveCell.Row

TextBox1.Value = Worksheets("DATA").Cells(sil_satır, 1)
TextBox2.Value = Worksheets("DATA").Cells(sil_satır, 2)
TextBox3.Value = Worksheets("DATA").Cells(sil_satır, 3)
TextBox4.Value = Worksheets("DATA").Cells(sil_satır, 4)
TextBox5.Value = Worksheets("DATA").Cells(sil_satır, 5)
TextBox6.Value = Worksheets("DATA").Cells(sil_satır, 6)
TextBox7.Value = Worksheets("DATA").Cells(sil_satır, 7)
TextBox8.Value = Worksheets("DATA").Cells(sil_satır, 8)
TextBox9.Value = Worksheets("DATA").Cells(sil_satır, 9)
TextBox10.Value = Worksheets("DATA").Cells(sil_satır, 10)
TextBox11.Value = Worksheets("DATA").Cells(sil_satır, 11)
TextBox12.Value = Worksheets("DATA").Cells(sil_satır, 12)
TextBox13.Value = Worksheets("DATA").Cells(sil_satır, 13)
TextBox14.Value = Worksheets("DATA").Cells(sil_satır, 14)
TextBox15.Value = Worksheets("DATA").Cells(sil_satır, 15)
TextBox16.Value = Worksheets("DATA").Cells(sil_satır, 16)
TextBox17.Value = Worksheets("DATA").Cells(sil_satır, 17)
TextBox18.Value = Worksheets("DATA").Cells(sil_satır, 18)
TextBox19.Value = Worksheets("DATA").Cells(sil_satır, 19)
TextBox20.Value = Worksheets("DATA").Cells(sil_satır, 20)
TextBox21.Value = Worksheets("DATA").Cells(sil_satır, 21)
TextBox22.Value = Worksheets("DATA").Cells(sil_satır, 22)
TextBox23.Value = Worksheets("DATA").Cells(sil_satır, 23)
TextBox24.Value = Worksheets("DATA").Cells(sil_satır, 24)
TextBox25.Value = Worksheets("DATA").Cells(sil_satır, 25)
TextBox26.Value = Worksheets("DATA").Cells(sil_satır, 26)
TextBox27.Value = Worksheets("DATA").Cells(sil_satır, 27)
TextBox28.Value = Worksheets("DATA").Cells(sil_satır, 28)
TextBox29.Value = Worksheets("DATA").Cells(sil_satır, 29)


Exit Sub
Bitir: MsgBox "Aranan Kayıt Bulunamadı"
End Sub


Kod Başlangıç;

Dim SonSatır, aranan, sil_satır, değiştir_satır As Variant

Private Sub CommandButton8_Click()
Application.Visible = True
Unload Me
End Sub
Private Sub CommandButton1_Click()

SonSatır = WorksheetFunction.CountA(Worksheets("Data").Range("A:A")) + 5

Worksheets("Data").Cells(SonSatır, 1) = TextBox1.Value
Worksheets("Data").Cells(SonSatır, 2) = TextBox2.Value
Worksheets("Data").Cells(SonSatır, 3) = TextBox3.Value
Worksheets("Data").Cells(SonSatır, 4) = TextBox4.Value
Worksheets("Data").Cells(SonSatır, 5) = TextBox5.Value
Worksheets("Data").Cells(SonSatır, 6) = TextBox6.Value
Worksheets("Data").Cells(SonSatır, 7) = TextBox7.Value
Worksheets("Data").Cells(SonSatır, 8) = TextBox8.Value
Worksheets("Data").Cells(SonSatır, 9) = TextBox9.Value
Worksheets("Data").Cells(SonSatır, 10) = TextBox10.Value
Worksheets("Data").Cells(SonSatır, 11) = TextBox11.Value
Worksheets("Data").Cells(SonSatır, 12) = TextBox12.Value
Worksheets("Data").Cells(SonSatır, 13) = TextBox13.Value
Worksheets("Data").Cells(SonSatır, 14) = TextBox14.Value
Worksheets("Data").Cells(SonSatır, 15) = TextBox15.Value
Worksheets("Data").Cells(SonSatır, 16) = TextBox16.Value
Worksheets("Data").Cells(SonSatır, 17) = TextBox17.Value
Worksheets("Data").Cells(SonSatır, 18) = TextBox18.Value
Worksheets("Data").Cells(SonSatır, 19) = TextBox19.Value
Worksheets("Data").Cells(SonSatır, 20) = TextBox20.Value
Worksheets("Data").Cells(SonSatır, 21) = TextBox21.Value
Worksheets("Data").Cells(SonSatır, 22) = TextBox22.Value
Worksheets("Data").Cells(SonSatır, 23) = TextBox23.Value
Worksheets("Data").Cells(SonSatır, 24) = TextBox24.Value
Worksheets("Data").Cells(SonSatır, 25) = TextBox25.Value
Worksheets("Data").Cells(SonSatır, 26) = TextBox26.Value
Worksheets("Data").Cells(SonSatır, 27) = TextBox27.Value
Worksheets("Data").Cells(SonSatır, 28) = TextBox28.Value
Worksheets("Data").Cells(SonSatır, 29) = TextBox29.Value

End Sub

Private Sub CommandButton2_Click()

On Error GoTo Bitir
aranan = InputBox("Aramak istediğiniz 8 Haneli Özel Kod değerini giriniz", "Arama Yap", " ")
Range("A:A").Find(aranan).Select
sil_satır = ActiveCell.Row

TextBox1.Value = Worksheets("DATA").Cells(sil_satır, 1)
TextBox2.Value = Worksheets("DATA").Cells(sil_satır, 2)
TextBox3.Value = Worksheets("DATA").Cells(sil_satır, 3)
TextBox4.Value = Worksheets("DATA").Cells(sil_satır, 4)
TextBox5.Value = Worksheets("DATA").Cells(sil_satır, 5)
TextBox6.Value = Worksheets("DATA").Cells(sil_satır, 6)
TextBox7.Value = Worksheets("DATA").Cells(sil_satır, 7)
TextBox8.Value = Worksheets("DATA").Cells(sil_satır, 8)
TextBox9.Value = Worksheets("DATA").Cells(sil_satır, 9)
TextBox10.Value = Worksheets("DATA").Cells(sil_satır, 10)
TextBox11.Value = Worksheets("DATA").Cells(sil_satır, 11)
TextBox12.Value = Worksheets("DATA").Cells(sil_satır, 12)
TextBox13.Value = Worksheets("DATA").Cells(sil_satır, 13)
TextBox14.Value = Worksheets("DATA").Cells(sil_satır, 14)
TextBox15.Value = Worksheets("DATA").Cells(sil_satır, 15)
TextBox16.Value = Worksheets("DATA").Cells(sil_satır, 16)
TextBox17.Value = Worksheets("DATA").Cells(sil_satır, 17)
TextBox18.Value = Worksheets("DATA").Cells(sil_satır, 18)
TextBox19.Value = Worksheets("DATA").Cells(sil_satır, 19)
TextBox20.Value = Worksheets("DATA").Cells(sil_satır, 20)
TextBox21.Value = Worksheets("DATA").Cells(sil_satır, 21)
TextBox22.Value = Worksheets("DATA").Cells(sil_satır, 22)
TextBox23.Value = Worksheets("DATA").Cells(sil_satır, 23)
TextBox24.Value = Worksheets("DATA").Cells(sil_satır, 24)
TextBox25.Value = Worksheets("DATA").Cells(sil_satır, 25)
TextBox26.Value = Worksheets("DATA").Cells(sil_satır, 26)
TextBox27.Value = Worksheets("DATA").Cells(sil_satır, 27)
TextBox28.Value = Worksheets("DATA").Cells(sil_satır, 28)
TextBox29.Value = Worksheets("DATA").Cells(sil_satır, 29)


Exit Sub
Bitir: MsgBox "Aranan Kayıt Bulunamadı"
End Sub

Private Sub CommandButton3_Click()
If TextBox1.Value <> "" Then
Dim Komut As Integer
Dim Mesaj As String
Dim Başlık As String

Mesaj = TextBox1.Value & " numaralı kayır silinecek eminmisiniz!.."
Başlık = "Silme İşlemi"
Komut = MsgBox(Mesaj, vbYesNo + vbQuestion, Başlık)

If Komut = 6 Then
Rows(ActiveCell.Row).Delete
TextBox1.Value = ""
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
TextBox5.Value = ""
TextBox6.Value = ""
TextBox7.Value = ""
TextBox8.Value = ""
TextBox9.Value = ""
TextBox10.Value = ""
TextBox11.Value = ""
TextBox12.Value = ""
TextBox13.Value = ""
TextBox14.Value = ""
TextBox15.Value = ""
TextBox16.Value = ""
TextBox17.Value = ""
TextBox18.Value = ""
TextBox19.Value = ""
TextBox20.Value = ""
TextBox21.Value = ""
TextBox22.Value = ""
TextBox23.Value = ""
TextBox24.Value = ""
TextBox25.Value = ""
TextBox26.Value = ""
TextBox27.Value = ""
TextBox28.Value = ""
TextBox29.Value = ""

Else
MsgBox "Silme işlemini iptal ettiniz..!"
End If
Else
MsgBox "Öncelikle bul butonu yardımı ile bir kayıt seçmelisin!.."
End If
End Sub

Private Sub CommandButton4_Click()
On Error GoTo Bitir
aranan = TextBox1.Value
Range("A:A").Find(aranan).Select
değiştir_satır = ActiveCell.Row

Worksheets("Data").Cells(değiştir_satır, 1) = TextBox1.Value
Worksheets("Data").Cells(değiştir_satır, 2) = TextBox2.Value
Worksheets("Data").Cells(değiştir_satır, 3) = TextBox3.Value
Worksheets("Data").Cells(değiştir_satır, 4) = TextBox4.Value
Worksheets("Data").Cells(değiştir_satır, 5) = TextBox5.Value
Worksheets("Data").Cells(değiştir_satır, 6) = TextBox6.Value
Worksheets("Data").Cells(değiştir_satır, 7) = TextBox7.Value
Worksheets("Data").Cells(değiştir_satır, 8) = TextBox8.Value
Worksheets("Data").Cells(değiştir_satır, 9) = TextBox9.Value
Worksheets("Data").Cells(değiştir_satır, 10) = TextBox10.Value
Worksheets("Data").Cells(değiştir_satır, 11) = TextBox11.Value
Worksheets("Data").Cells(değiştir_satır, 12) = TextBox12.Value
Worksheets("Data").Cells(değiştir_satır, 13) = TextBox13.Value
Worksheets("Data").Cells(değiştir_satır, 14) = TextBox14.Value
Worksheets("Data").Cells(değiştir_satır, 15) = TextBox15.Value
Worksheets("Data").Cells(değiştir_satır, 16) = TextBox16.Value
Worksheets("Data").Cells(değiştir_satır, 17) = TextBox17.Value
Worksheets("Data").Cells(değiştir_satır, 18) = TextBox18.Value
Worksheets("Data").Cells(değiştir_satır, 19) = TextBox19.Value
Worksheets("Data").Cells(değiştir_satır, 20) = TextBox20.Value
Worksheets("Data").Cells(değiştir_satır, 21) = TextBox21.Value
Worksheets("Data").Cells(değiştir_satır, 22) = TextBox22.Value
Worksheets("Data").Cells(değiştir_satır, 23) = TextBox23.Value
Worksheets("Data").Cells(değiştir_satır, 24) = TextBox24.Value
Worksheets("Data").Cells(değiştir_satır, 25) = TextBox25.Value
Worksheets("Data").Cells(değiştir_satır, 26) = TextBox26.Value
Worksheets("Data").Cells(değiştir_satır, 27) = TextBox27.Value
Worksheets("Data").Cells(değiştir_satır, 28) = TextBox28.Value
Worksheets("Data").Cells(değiştir_satır, 29) = TextBox29.Value

Bitir:
End Sub

Private Sub CommandButton5_Click()
Worksheets("Data").PrintOut
End Sub

Private Sub CommandButton6_Click()

With Application.FileDialog(msoFileDialogOpen)

.Filters.Clear
.Filters.Add "Excel 2007-13", "*.xlsx;*.xlsm;*.xlsa"
.AllowMultiSelect = False
.Show

If .SelectedItems.Count = 0 Then

MsgBox "Lütfen veri çekmek istediğiniz Excel dosyasını seçiniz"
Exit Sub

End If

kopya = InputBox("Kopyalamak istediğiniz veri aralığını yazınız.", Default:="A2:G2")
yapistir = InputBox("Yapıştırmak istediğiniz hücreyi yazınız.", Default:="A6:G6")

Application.Workbooks.Open .SelectedItems(1)
Set kaynak = Application.ActiveWorkbook

'kaynak.Sheets("Sayfa1").Range(kopya).Copy
kaynak.ActiveSheet.Range(kopya).Copy ThisWorkbook.ActiveSheet.Range(yapistir)
kaynak.Close False


End With

End Sub

Private Sub CommandButton7_Click()
Application.Visible = True
End Sub

 

[Necdet]

Merhaba,

Find Komutunu döngü ile kullanmalısınız.
VBA nın Find komutu Aşağıdaki gibi. Kendinize uyarlayınız.

With Worksheets(1).Range("a:a")
    Set c = .Find(ArananDeger, lookin:=xlValues)
    If Not c Is Nothing Then
        IlkAddress = c.Address
        Do
            Kodlarınız
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> IlkAddress
    End If
End With

 

[TiOr]

Merhaba,

Find Komutunu döngü ile kullanmalısınız.
VBA nın Find komutu Aşağıdaki gibi. Kendinize uyarlayınız.

With Worksheets(1).Range("a:a")
    Set c = .Find(ArananDeger, lookin:=xlValues)
    If Not c Is Nothing Then
        IlkAddress = c.Address
        Do
            Kodlarınız
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> IlkAddress
    End If
End With

Merhaba Necdet Bey,
Bilgi için teşekkür ederim fakat farklı bir yöntem ile projeyi tamamlamış bulunmaktayım. Belki faydalı olur kodlamayı aşağıda paylaşıyorum;
"Bul/Sonrakini Bul/Öncekini Bul"
Hayırlı geceler...

************************************************************************************************************************************************************
Private Sub CommandButton1_Click()

Cells.Interior.ColorIndex = xlColorIndexNone

Dim fc As Range ' FindCell = Aranan Hücre
Set fc = Worksheets("Sayfa1").Columns("A").Find(what:=TextBox1, LookAt:=xlWhole)
fc.Select
ActiveCell.Cells.Interior.ColorIndex = 4
x = ActiveCell.Row
y = ActiveCell.Column

MsgBox "Aradığınız Kişi İle İlgili İlk Kayıt " & vbNewLine & vbNewLine & x & ". Satırda " & y & ". Sütunundadır.", vbInformation, "BULUNDU..."

End Sub

Private Sub CommandButton2_Click()
Cells.Interior.ColorIndex = xlColorIndexNone
Dim fc As Range
satır = ActiveCell.Row
sütun = ActiveCell.Column
Set fc = ActiveCell
Set fc = Worksheets("Sayfa1").Columns("A").FindNext(after:=fc)
fc.Select
ActiveCell.Cells.Interior.ColorIndex = 4
x = ActiveCell.Row
y = ActiveCell.Column
If x < satır Then
Cells(satır, sütun).Select
Cells.Interior.ColorIndex = xlColorIndexNone
ActiveCell.Cells.Interior.ColorIndex = 4
MsgBox "SON KAYIDA ULAŞTINIZ!...", vbCritical
Exit Sub
End If
MsgBox "Aradığınız Kişi İle İlgili Diğer Kayıt " & vbNewLine & vbNewLine & x & ". Satırda " & y & ". Sütunundadır.", vbInformation, "BULUNDU..."

End Sub

Private Sub CommandButton3_Click()
Cells.Interior.ColorIndex = xlColorIndexNone
Dim fc As Range
satır = ActiveCell.Row
sütun = ActiveCell.Column
Set fc = ActiveCell
Set fc = Worksheets("Sayfa1").Columns("A").FindPrevious(after:=fc)
fc.Select
ActiveCell.Cells.Interior.ColorIndex = 4
x = ActiveCell.Row
y = ActiveCell.Column
If x > satır Then
Cells(satır, sütun).Select
Cells.Interior.ColorIndex = xlColorIndexNone
ActiveCell.Cells.Interior.ColorIndex = 4
MsgBox "İLK KAYIDA ULAŞTINIZ!...", vbCritical
Exit Sub
End If
MsgBox "Aradığınız Kişi İle İlgili Diğer Kayıt " & vbNewLine & vbNewLine & x & ". Satırda " & y & ". Sütunundadır.", vbInformation, "BULUNDU..."
End Sub