Soru Harf bazında Kontrol ?

M

mogola

Katılım
18 Nisan 2019
Mesajlar
31
Excel Vers. ve Dili
office 2016
Altın Üyelik Bitiş Tarihi
24-07-2020
Arkadaşlar P-F-M-U DİYE SAYFALAR VAR EXCELDE ben bunlara barkod okutyorum Mesela M olan sayfaya M İle başlayan barkodları okutuyorum bazen "F" ile başlayan barkodları "M" SAYFASINA OKUTUNCA HATA uyarı vermesini istiyorum


ÖRNEK

M SAYFASINDA

M7064703062019D1590190412
M7064703062019D1590190413
M7064703062019D1590190414
F7064703062019D1590190417 = FARKLI HARF İLE BAŞLAYINCA NASIL HATA verdirebilirim ?

ayni şekilde "F" SAYFASINDA "F" Dışında harfli barkod girilirse hata vermesini nasıl yaparım
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Okutma ya da veri girme işlemi nasıl yapılıyor bilmeden çözüm bulunamaz. Örnek dosya paylaşın lütfen.
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki kodları dosyanızın ThisWorkBook/BuÇalışmaSayfası bölümüne yapıştırarak deneyiniz:

PHP: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Range("C2:C10000")) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
If Left(Target, 1) <> Trim(ActiveSheet.Name) Then
    MsgBox Left(Target, 1) & " kodlu ürünü " & ActiveSheet.Name & " sayfasına ekleyemezsiniz.", vbCritical
    Sheets(Left(Target, 1)).Activate
    yeni = ActiveSheet.Cells(Rows.Count, "C").End(3).Row + 1
    ActiveSheet.Cells(yeni, "C").Select
    ActiveSheet.Cells(yeni, "C") = Target
    Target = ""
End If
End Sub
Bu arada dosyanızda M sayfasının adında fazladan bir boşluk var, makro hata vermesin diye Trim fonksiyonunu kullandım, sayfa isimlendirirken dikkatli olmanızı öneririm.
 
M

mogola

Katılım
18 Nisan 2019
Mesajlar
31
Excel Vers. ve Dili
office 2016
Altın Üyelik Bitiş Tarihi
24-07-2020
YUSUF44' Alıntı:
Aşağıdaki kodları dosyanızın ThisWorkBook/BuÇalışmaSayfası bölümüne yapıştırarak deneyiniz:

PHP: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Range("C2:C10000")) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
If Left(Target, 1) <> Trim(ActiveSheet.Name) Then
    MsgBox Left(Target, 1) & " kodlu ürünü " & ActiveSheet.Name & " sayfasına ekleyemezsiniz.", vbCritical
    Sheets(Left(Target, 1)).Activate
    yeni = ActiveSheet.Cells(Rows.Count, "C").End(3).Row + 1
    ActiveSheet.Cells(yeni, "C").Select
    ActiveSheet.Cells(yeni, "C") = Target
    Target = ""
End If
End Sub
Bu arada dosyanızda M sayfasının adında fazladan bir boşluk var, makro hata vermesin diye Trim fonksiyonunu kullandım, sayfa isimlendirirken dikkatli olmanızı öneririm.
Genişletmek için tıkla ...
eline sağlık güzel olmuş SAYFA isimlerini değişince çalışmıyor BUG giriyor sayfa isimlerini koda göremedim ilerde başka bir projeye uyarlamak icin ne yapmam gerek
 
Son düzenleme:
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Sayfa isimlerini nasıl değişince mesela?
 
M

mogola

Katılım
18 Nisan 2019
Mesajlar
31
Excel Vers. ve Dili
office 2016
Altın Üyelik Bitiş Tarihi
24-07-2020
YUSUF44' Alıntı:
Sayfa isimlerini nasıl değişince mesela?
Genişletmek için tıkla ...
Excel içinde olan M-P-U-F isimleri değişince calışmıyor sürekli hata veriyor ...

yada

örnek exceldeki c sutununa herhangi bir veri girin çalışmayı durdurdu hatası verip excel kapanıyor çünkü sizin makroda sadece P-M-F-U SAYFALARINI BAZ alıyor bu harflerin dışında barkod da harf var ise var ise hata veriyor
 

Ekli dosyalar

YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki gibi dener misiniz?

PHP: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Range("C2:C10000")) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
sayfa = "yok"
If Left(Target, 1) <> Trim(ActiveSheet.Name) Then
    MsgBox Left(Target, 1) & " kodlu ürünü " & ActiveSheet.Name & " sayfasına ekleyemezsiniz.", vbCritical
    For i = 1 To Sheets.Count
        If Sheets(i).Name = Left(Target, 1) Then
            Sheets(i).Activate
            yeni = ActiveSheet.Cells(Rows.Count, "C").End(3).Row + 1
            ActiveSheet.Cells(yeni, "C").Select
            Application.EnableEvents = False
                ActiveSheet.Cells(yeni, "C") = Target
                Target = ""
            Application.EnableEvents = True
            sayfa = "var"
        End If
    Next
End If
If sayfa = "yok" Then
    MsgBox Left(Target, 1) & " sayfası mevcut değil.", vbCritical
    Application.EnableEvents = False
        Target = ""
    Application.EnableEvents = True
End If
End Sub
 
M

mogola

Katılım
18 Nisan 2019
Mesajlar
31
Excel Vers. ve Dili
office 2016
Altın Üyelik Bitiş Tarihi
24-07-2020
YUSUF44' Alıntı:
Aşağıdaki gibi dener misiniz?

PHP: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Range("C2:C10000")) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
sayfa = "yok"
If Left(Target, 1) <> Trim(ActiveSheet.Name) Then
    MsgBox Left(Target, 1) & " kodlu ürünü " & ActiveSheet.Name & " sayfasına ekleyemezsiniz.", vbCritical
    For i = 1 To Sheets.Count
        If Sheets(i).Name = Left(Target, 1) Then
            Sheets(i).Activate
            yeni = ActiveSheet.Cells(Rows.Count, "C").End(3).Row + 1
            ActiveSheet.Cells(yeni, "C").Select
            Application.EnableEvents = False
                ActiveSheet.Cells(yeni, "C") = Target
                Target = ""
            Application.EnableEvents = True
            sayfa = "var"
        End If
    Next
End If
If sayfa = "yok" Then
    MsgBox Left(Target, 1) & " sayfası mevcut değil.", vbCritical
    Application.EnableEvents = False
        Target = ""
    Application.EnableEvents = True
End If
End Sub
Genişletmek için tıkla ...

Çalıştı Teşekkürler..

Bir sorum daha var mesela
F sayfasına hem F li Hemde K içeren barkodları aynı sayfaya(F Sayfasına) eklemek istersem bunun için ne yapmam gerekiyor
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki gibi dener misiniz:

PHP: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Range("C2:C10000")) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
sayfa = "yok"
If Trim(ActiveSheet.Name) = "F" And Left(Target, 1) = "F" Or Left(Target, 1) = "K" Then Exit Sub

If Left(Target, 1) <> Trim(ActiveSheet.Name) Then
    MsgBox Left(Target, 1) & " kodlu ürünü " & ActiveSheet.Name & " sayfasına ekleyemezsiniz.", vbCritical
    For i = 1 To Sheets.Count
        If Sheets(i).Name = Left(Target, 1) Then
            Sheets(i).Activate
            yeni = ActiveSheet.Cells(Rows.Count, "C").End(3).Row + 1
            ActiveSheet.Cells(yeni, "C").Select
            Application.EnableEvents = False
                ActiveSheet.Cells(yeni, "C") = Target
                Target = ""
            Application.EnableEvents = True
            sayfa = "var"
        End If
    Next
End If

If sayfa = "yok" Then
    MsgBox Left(Target, 1) & " sayfası mevcut değil.", vbCritical
    Application.EnableEvents = False
        Target = ""
    Application.EnableEvents = True
End If
End Sub
 
M

mogola

Katılım
18 Nisan 2019
Mesajlar
31
Excel Vers. ve Dili
office 2016
Altın Üyelik Bitiş Tarihi
24-07-2020
YUSUF44' Alıntı:
Aşağıdaki gibi dener misiniz:

PHP: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Range("C2:C10000")) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
sayfa = "yok"
If Trim(ActiveSheet.Name) = "F" And Left(Target, 1) = "F" Or Left(Target, 1) = "K" Then Exit Sub

If Left(Target, 1) <> Trim(ActiveSheet.Name) Then
    MsgBox Left(Target, 1) & " kodlu ürünü " & ActiveSheet.Name & " sayfasına ekleyemezsiniz.", vbCritical
    For i = 1 To Sheets.Count
        If Sheets(i).Name = Left(Target, 1) Then
            Sheets(i).Activate
            yeni = ActiveSheet.Cells(Rows.Count, "C").End(3).Row + 1
            ActiveSheet.Cells(yeni, "C").Select
            Application.EnableEvents = False
                ActiveSheet.Cells(yeni, "C") = Target
                Target = ""
            Application.EnableEvents = True
            sayfa = "var"
        End If
    Next
End If

If sayfa = "yok" Then
    MsgBox Left(Target, 1) & " sayfası mevcut değil.", vbCritical
    Application.EnableEvents = False
        Target = ""
    Application.EnableEvents = True
End If
End Sub
Genişletmek için tıkla ...


eline sağlık süper
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst