• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Aranılan Şartı Sağlamayan Sutün verilerini alma

  • Konbuyu başlatan Konbuyu başlatan hmakkiz
  • Başlangıç tarihi Başlangıç tarihi
Kod: 
'Eğer H sütunu taksitli ise 
On Error Resume Next
        Veri = WF.Round(S1.Cells(X, "N") / S1.Cells(X, "S"), 3)
        On Error GoTo 0
        
        If S1.Cells(X, "N") <> 0 And S1.Cells(X, "S") = 0 Then
            Kontrol_1 = 1
        ElseIf Veri >= 0.045 And Veri <= 0.055 Then
            Kontrol_1 = 1
        ElseIf Veri >= 0.095 And Veri <= 0.105 Then
            Kontrol_1 = 1
        ElseIf Veri >= 0.14 And Veri <= 0.155 Then
            Kontrol_1 = 1
        ElseIf Veri = -1 Then
            Kontrol_1 = 1
        ElseIf Veri = 0 Then
            Kontrol_1 = 1
        End If
        
'Eğer H Sütunu Taksitli ise
        On Error Resume Next
        Veri = WF.Round(S1.Cells(X, "M") / S1.Cells(X, "S"), 3)
        On Error GoTo 0
        
        If S1.Cells(X, "M") <> 0 And S1.Cells(X, "S") = 0 Then
            Kontrol_2 = 1
        ElseIf Veri >= 0.045 And Veri <= 0.055 Then
            Kontrol_2 = 1
        ElseIf Veri >= 0.095 And Veri <= 0.105 Then
            Kontrol_2 = 1
        ElseIf Veri >= 0.14 And Veri <= 0.155 Then
            Kontrol_2 = 1
        ElseIf Veri = -1 Then
            Kontrol_2 = 1
        ElseIf Veri = 0 Then
            Kontrol_2 = 1
        End If

'Eğer H sütunu Peşin ise
       On Error Resume Next
        Veri = WF.Round(S1.Cells(X, "M") / S1.Cells(X, "S"), 3)
        On Error GoTo 0
        
        If S1.Cells(X, "M") <> 0 And S1.Cells(X, "S") = 0 Then
            Kontrol_3 = 1

        End If
'Eğer H Sütunu Peşin ise
        On Error Resume Next
        Veri = WF.Round(S1.Cells(X, "M") / S1.Cells(X, "S"), 3)
        On Error GoTo 0
        
        If S1.Cells(X, "M") <> 0 And S1.Cells(X, "S") = 0 Then
            Kontrol_4 = 1
        ElseIf Veri >= 0.045 And Veri <= 0.055 Then
            Kontrol_4 = 1

        End If
 
Merhaba,
Bu iş sanıyorum bağımlılık yapıyor, uğraştıkça uğraşasım geliyor :)
ben bi düzenleme yaptım seleckt case kullandım ama çalıştırdığımda olmadı :)
yardım talep ediyorum.
Kod: 
Private Sub CommandButton1_Click()

    Dim S1 As Worksheet, S2 As Worksheet
    Dim X As Long, Satır As Long
    Dim Kontrol_1 As Byte, Kontrol_2 As Byte
    Dim Veri, WF As WorksheetFunction
    
    Set S1 = Sheets("Veri Girişi")
    Set S2 = Sheets("Tutanak")
    Set WF = WorksheetFunction
    Satır = 25
    
    S2.Range("A25:J" & Rows.Count).ClearContents
    
    For X = 2 To S1.Cells(Rows.Count, 1).End(3).Row
        On Error Resume Next
        Veri = WF.Round(S1.Cells(X, "N") / S1.Cells(X, "S"), 3)
        On Error GoTo 0
   
    If S1.Cells(X, "H") = "taksit1" Or S1.Cells(X, "H") = "taksit2" Then

    Select Case Veri
        Case 0.045 To 0.055
            Kontrol_1 = 1
        Case 0.095 To 0.105
            Kontrol_1 = 1
        Case 0.14 To 0.155
            Kontrol_1 = 1
        Case 0.99 To 1.01
            Kontrol_1 = 1
        Case -1
            Kontrol_1 = 1
        Case 0
            Kontrol_1 = 1
End Select
      
      ElseIf S1.Cells(X, "H") = "peşin1" Or S1.Cells(X, "H") = "peşin2" Then
Select Case Veri
        Case 0.095 To 0.105
            Kontrol_1 = 1
        Case 0.14 To 0.155
            Kontrol_1 = 1
        Case 0.99 To 1.01
            Kontrol_1 = 1
        Case -1
            Kontrol_1 = 1
        Case 0
            Kontrol_1 = 1
End Select
End If
                 
        On Error Resume Next
        Veri = WF.Round(S1.Cells(X, "M") / S1.Cells(X, "S"), 3)
        On Error GoTo 0
        
         If S1.Cells(X, "H") = "taksit1" Or S1.Cells(X, "H") = "taksit2" Then
    Select Case Veri
        Case 0.045 To 0.055
            Kontrol_2 = 1
        Case 0.095 To 0.105
            Kontrol_2 = 1
        Case 0.14 To 0.155
            Kontrol_2 = 1
        Case 0.99 To 1.01
            Kontrol_2 = 1
        Case -1
            Kontrol_2 = 1
        Case 0
            Kontrol_2 = 1
                    
End Select
      ElseIf S1.Cells(X, "H") = "peşin1" Or S1.Cells(X, "H") = "peşin2" Then
Select Case Veri
        Case 0.095 To 0.105
            Kontrol_2 = 1
        Case 0.14 To 0.155
            Kontrol_2 = 1
        Case 0.99 To 1.01
            Kontrol_2 = 1
        Case -1
            Kontrol_2 = 1
        Case 0
            Kontrol_2 = 1
End Select
End If
        If Kontrol_1 <> 1 Or Kontrol_2 <> 1 Then
            S2.Cells(Satır, 1) = S1.Cells(X, "D")
            S2.Cells(Satır, 2) = S1.Cells(X, "E")
            S2.Cells(Satır, 3) = S1.Cells(X, "G")
            S2.Cells(Satır, 4) = S1.Cells(X, "H")
            S2.Cells(Satır, 5) = S1.Cells(X, "I")
            S2.Cells(Satır, 6) = S1.Cells(X, "J")
            S2.Cells(Satır, 7) = S1.Cells(X, "K")
            S2.Cells(Satır, 8) = S1.Cells(X, "M")
            S2.Cells(Satır, 9) = S1.Cells(X, "N")
            S2.Cells(Satır, 10) = S1.Cells(X, "S")
            Satır = Satır + 1
        End If
    
        Kontrol_1 = 0: Kontrol_2 = 0
    Next
                
    S2.Select
    
    Set S1 = Nothing
    Set S2 = Nothing
    Set WF = Nothing
    
    MsgBox ("İşlem tamam"), vbInformation
End Sub
 
Merhaba,
Bu formun varlığı bile yetiyo çözümsüz kaldığımız noktalarda :) supersiniz...
Select case yerine if döngüsü içerinde And ile istediğimi yaptırdım. Tekrar teşekkür ediyorum yardımlarınız için.
 
Merhaba,

İşlerimin yoğunluğu arttığı için sorunuzla ilgilenemedim. Ama sizin için faydalı olduğunu görüyorum. Kendi kendinize çözüm bulmuşsunuz. Bu duruma açıkçası sevindim.

Çözdüğünüze dair geri dönüş yaptığınız için ayrıca teşekkür ederim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst