• DİKKAT

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

Koşula Uyanları Yazdır

sahir73

Altın Üye
Katılım
17 Nisan 2019
Mesajlar
74
Excel Vers. ve Dili
Office 2016 Professional Plus 32 Bit
Merhaba dostlar sorunum şu;
230033

Resimde görüleceği üzere eğer a sutunundaki hücrelerde "e" yazıyor ise sadece o satırın karşısındaki bilgileri aktarıp yazsın formu eğer "h" ise o personele ait bilgileri aktarıp yazmasın. Sorunun çoğunu halettim ama bu seferde sonsuz döngüye giriyor. Yardımlarınız bekliyorum
Kod:
Private Sub Image3_Click()
    Dim wsPeroneller As Worksheet
    Dim wsForm      As Worksheet
    Dim sonSatir    As Long
    Dim X           As Long
    Dim cevap       As Byte
   
    Set wsPersoneller = ThisWorkbook.Sheets("Personeller")
    Set wsForm = ThisWorkbook.Sheets("Form")
    sonSatir = wsPersoneller.Cells(Rows.Count, "B").End(3).Row
   
   
   
    For X = 2 To sonSatir
       If wsPersoneller.Range("A" & X).Value = "e" Then
       cevap = 1
       ElseIf wsPersoneller.Range("A" & X).Value = "h" Then
       cevap = 0
       End If
     
     
      If cevap = 1 Then
   
        wsForm.Range("D7").Value = wsPersoneller.Range("B" & X).Value
        wsForm.Range("F7").Value = wsPersoneller.Range("C" & X).Value
        wsForm.Range("I7").Value = wsPersoneller.Range("D" & X).Value

        On Error Resume Next
        wsForm.Select
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
         
       End If
    Next X
  '  MsgBox "test"
End Sub
 

Ekli dosyalar

Hücrelere 1 0 yazınca sorunsuz çalışıyor ama 1 0 yerine e h yazınca bir sıkıntı çıkıyor

If wsPersoneller.Range("A" & X).Value = "e" Then
cevap = 1
ElseIf wsPersoneller.Range("A" & X).Value = "h" Then
cevap = 0
End If
bu kod bloğu gereksiz gibi kendimce e ve h yi 1 ve 0 a döndürmeye çalıştım
 
sorunumu yanlış anlattım, çözümü buldum . Konu kapanabilir.
 
Geri
Üst