ComboBox Problemi

akmes · 4 Haziran 2013

Merhaba, Aşağıdaki ComboBoxlar ile diğer sayfadan veri alıyorum alınan verilerin sadece değer ve biçimlerin alınması için formülde nasıl bir değişiklik yapmalıyım bu şekilde alınan hücrelerdeki tüm formüllerde alınıyor. Yardımlarınızı rica ediyorum.

Private Sub CheckBox1_Click()
If CheckBox1.Value = False Then
Range("A3:b3").Select
Selection.AutoFilter
Exit Sub
ElseIf CheckBox1.Value = True Then
Range("A3:b3").Select
Selection.AutoFilter
End If
End Sub
Private Sub TextBox1_Change()
If TextBox1.Text <> "" Then
suzul = suz(1, "*" & TextBox1.Text & "*")
Else
Selection.AutoFilter field:=1
End If
End Sub
Private Sub TextBox2_Change()
If TextBox2.Text <> "" Then
suzul = suz(2, "" & TextBox2.Text & "")
Else
Selection.AutoFilter field:=2
End If
End Sub
Option Explicit

Private Sub ComboBox1_Change()

Dim cll As Range
Dim ws As Worksheet

On Error Resume Next

Set ws = Sheets("Mac Det")
Set cll = ws.Columns(1).Find(ComboBox1.Value, LookIn:=xlValues, LookAt:=xlWhole)

If cll Is Nothing Then Exit Sub

cll.Offset(2, 0).Resize(6, 10).Copy Me.Range("F4")

End Sub

Private Sub ComboBox2_Change()

Dim cll As Range
Dim ws As Worksheet

On Error Resume Next

Set ws = Sheets("Mac Det")
Set cll = ws.Columns(1).Find(ComboBox2.Value, LookIn:=xlValues, LookAt:=xlWhole)

If cll Is Nothing Then Exit Sub

cll.Offset(2, 0).Resize(6, 10).Copy Me.Range("F14")

End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 8 Then
If Intersect(Target, Range("H25:H450")) Is Nothing Then Exit Sub
ComboBox1 = Target
ElseIf Target.Column = 9 Then
If Intersect(Target, Range("I25:I450")) Is Nothing Then Exit Sub
ComboBox2 = Target
End If
End Sub

Muzaffer Ali · 4 Haziran 2013

Yeni kodlar aşağıdaki gibi olacak

Kod:

Private Sub CheckBox1_Click()
 If CheckBox1.Value = False Then
 Range("A3:b3").Select
 Selection.AutoFilter
 Exit Sub
 ElseIf CheckBox1.Value = True Then
 Range("A3:b3").Select
 Selection.AutoFilter
 End If
 End Sub
 Private Sub TextBox1_Change()
 If TextBox1.Text <> "" Then
 suzul = suz(1, "*" & TextBox1.Text & "*")
 Else
 Selection.AutoFilter field:=1
 End If
 End Sub
 Private Sub TextBox2_Change()
 If TextBox2.Text <> "" Then
 suzul = suz(2, "" & TextBox2.Text & "")
 Else
 Selection.AutoFilter field:=2
 End If
 End Sub
 Option Explicit

 Private Sub ComboBox1_Change()

 Dim cll As Range
 Dim ws As Worksheet

 On Error Resume Next

 Set ws = Sheets("Mac Det")
 Set cll = ws.Columns(1).Find(ComboBox1.Value, LookIn:=xlValues, LookAt:=xlWhole)

 If cll Is Nothing Then Exit Sub

 
    KopyalaYapistir
 End Sub

 Private Sub ComboBox2_Change()

 Dim cll As Range
 Dim ws As Worksheet

 On Error Resume Next

 Set ws = Sheets("Mac Det")
 Set cll = ws.Columns(1).Find(ComboBox2.Value, LookIn:=xlValues, LookAt:=xlWhole)

 If cll Is Nothing Then Exit Sub

    KopyalaYapistir
 End Sub
 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 If Target.Column = 8 Then
 If Intersect(Target, Range("H25:H450")) Is Nothing Then Exit Sub
 ComboBox1 = Target
 ElseIf Target.Column = 9 Then
 If Intersect(Target, Range("I25:I450")) Is Nothing Then Exit Sub
 ComboBox2 = Target
 End If
 End Sub

Sub KopyalaYapistir()

    cll.Offset(2, 0).Resize(6, 10).Copy
    Me.Range("F4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    cll.Offset(2, 0).Resize(6, 10).Copy
    Me.Range("F4").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
End Sub

akmes · 5 Haziran 2013

dalgalikur' Alıntı:

Yeni kodlar aşağıdaki gibi olacak

Kod:

Private Sub CheckBox1_Click()
 If CheckBox1.Value = False Then
 Range("A3:b3").Select
 Selection.AutoFilter
 Exit Sub
 ElseIf CheckBox1.Value = True Then
 Range("A3:b3").Select
 Selection.AutoFilter
 End If
 End Sub
 Private Sub TextBox1_Change()
 If TextBox1.Text <> "" Then
 suzul = suz(1, "*" & TextBox1.Text & "*")
 Else
 Selection.AutoFilter field:=1
 End If
 End Sub
 Private Sub TextBox2_Change()
 If TextBox2.Text <> "" Then
 suzul = suz(2, "" & TextBox2.Text & "")
 Else
 Selection.AutoFilter field:=2
 End If
 End Sub
 Option Explicit

 Private Sub ComboBox1_Change()

 Dim cll As Range
 Dim ws As Worksheet

 On Error Resume Next

 Set ws = Sheets("Mac Det")
 Set cll = ws.Columns(1).Find(ComboBox1.Value, LookIn:=xlValues, LookAt:=xlWhole)

 If cll Is Nothing Then Exit Sub

 
    KopyalaYapistir
 End Sub

 Private Sub ComboBox2_Change()

 Dim cll As Range
 Dim ws As Worksheet

 On Error Resume Next

 Set ws = Sheets("Mac Det")
 Set cll = ws.Columns(1).Find(ComboBox2.Value, LookIn:=xlValues, LookAt:=xlWhole)

 If cll Is Nothing Then Exit Sub

    KopyalaYapistir
 End Sub
 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 If Target.Column = 8 Then
 If Intersect(Target, Range("H25:H450")) Is Nothing Then Exit Sub
 ComboBox1 = Target
 ElseIf Target.Column = 9 Then
 If Intersect(Target, Range("I25:I450")) Is Nothing Then Exit Sub
 ComboBox2 = Target
 End If
 End Sub

Sub KopyalaYapistir()

    cll.Offset(2, 0).Resize(6, 10).Copy
    Me.Range("F4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    cll.Offset(2, 0).Resize(6, 10).Copy
    Me.Range("F4").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
End Sub

Üstadım , yardımınız için çok teşekkür ederim.

ComboBox Problemi

akmes

Muzaffer Ali

Destek Ekibi

akmes