Vba yardım ilave

[bulentkars]

Merhaba

az önce istediğim çalışma oldu fakat atladığım bı hata var dosyayı ıncelersenız sevınıırm.şimdiden çok teşekkür ederim

 

[Orion1]

Dosyanız ekte.

Private Sub CommandButton1_Click()
Dim k As Range, adr As String
If Not IsNumeric(TextBox2.Text) Then
    MsgBox "Stok miktarı sayısal bir değer olmalıdır..!!", vbCritical, "UYARI"
    TextBox2.SetFocus
    Exit Sub
End If
Set k = Range("E2:E65536").Find(ComboBox2.Value, , xlValues, xlWhole, , 1)
If Not k Is Nothing Then
    adr = k.Address
    Do
        k.Offset(0, -4).Value = CDbl(TextBox2.Text)
        Set k = Range("E2:E65536").FindNext(k)
    Loop While adr <> k.Address And Not k Is Nothing
End If
MsgBox "İşlem Tamamdır..!!", vbOKOnly + vbInformation, "İŞLEM TAMAM"
End Sub

Private Sub UserForm_Click()

End Sub

Private Sub UserForm_Initialize()
ComboBox2.RowSource = "E2:E" & Cells(65536, "E").End(xlUp).Row
ComboBox2.ListIndex = 0
End Sub

 

[leumruk]

Ekli dosyayı inceleyiniz.

 

[bulentkars]

teşekkür ederim comboboxta bir firmayı sadece 1 tane görsek çok güzel olacak yinede elinize sağlık

 

[Orion1]

teşekkür ederim comboboxta bir firmayı sadece 1 tane görsek çok güzel olacak yinede elinize sağlık

Dosyanız ekte.

Private Sub CommandButton1_Click()
Dim k As Range, adr As String
If Not IsNumeric(TextBox2.Text) Then
    MsgBox "Stok miktarı sayısal bir değer olmalıdır..!!", vbCritical, "UYARI"
    TextBox2.SetFocus
    Exit Sub
End If
Set k = Range("E2:E65536").Find(ComboBox2.Value, , xlValues, xlWhole, , 1)
If Not k Is Nothing Then
    adr = k.Address
    Do
        k.Offset(0, -4).Value = CDbl(TextBox2.Text)
        Set k = Range("E2:E65536").FindNext(k)
    Loop While adr <> k.Address And Not k Is Nothing
End If
MsgBox "İşlem Tamamdır..!!", vbOKOnly + vbInformation, "İŞLEM TAMAM"
End Sub

Private Sub UserForm_Click()

End Sub

Private Sub UserForm_Initialize()
Dim myarr As Variant, a As Long
ReDim myarr(1 To 1, 1 To 1)
For i = 2 To Cells(65536, "E").End(xlUp).Row
    If WorksheetFunction.CountIf(Range("E2:E" & i), Cells(i, "E").Value) = 1 Then
        a = a + 1
        ReDim Preserve myarr(1 To 1, 1 To a)
        myarr(1, a) = Cells(i, "E").Value
    End If
Next i
If a > 0 Then
    ComboBox2.Column = myarr
    ComboBox2.ListIndex = 0
End If
Erase myarr
End Sub

 

[bulentkars]

çok teşekkür ederim elinize sağlık

 

[Orion1]

çok teşekkür ederim elinize sağlık

Rica ederim.
İyi çalışmalar.