mehrere Zellen auf inhalt prüfen

Moderator: ModerationP

mehrere Zellen auf inhalt prüfen

Beitragvon robigast » 16. Apr 2018, 16:03

Hallo Grüße euch !

Habe wieder ein anliegen an euch, bin schon sehr weit gekommen.

Würde von euch noch brauchen, eine art zellen Prüfung auf Inhalt,habe einen Code der funktioniert aber wird sehr lange ca. 30 - 40 zellen


Beispiel: im Code habe einmal 4 zellen auf prüfung. funktioniert aber wird sehr lange gibt es einen einfachere Art
Code: Alles auswählen
If Sheets("Eingabemaske").Range("L6").Value <> "" Then
Sheets("Eingabemaske").Range("L6").Copy Sheets("Checkliste Runde").Range("I12")
Else
MsgBox "Kein entsprechender Wert in Eingabemaske , Zelle L6 !"
End If
    If Sheets("Eingabemaske").Range("M6").Value <> "" Then
    Sheets("Eingabemaske").Range("M6").Copy Sheets("Checkliste").Range("I15")
    Else
    MsgBox "Kein entsprechender Wert in Eingabemaske , Zelle M6 !"
    End If
   
If Sheets("Eingabemaske").Range("N6").Value <> "" Then
Sheets("Eingabemaske").Range("N6").Copy Sheets("Checkliste").Range("I18")
Else
MsgBox "Kein entsprechender Wert in Eingabemaske , Zelle N6 !"
End If
    If Sheets("Eingabemaske").Range("O6").Value <> "" Then
    Sheets("Eingabemaske").Range("O6").Copy Sheets("Checkliste").Range("I21")
    Else
    MsgBox "Kein entsprechender Wert in Eingabemaske , Zelle O6 !"
    End If


Vielleicht hat jemand einen kürzere und einfachere lösung.

lg robi
robigast
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 46
Registriert: 08. Apr 2018, 19:03

Re: mehrere Zellen auf inhalt prüfen

Beitragvon slowboarder » 16. Apr 2018, 16:12

Hi

wenn die Eingabezellen direkt nebeneinander liegen und die Zielzellen immer im gleichen Abstand voneinander liegen (+3), dann mit einer Schleife:

Code: Alles auswählen
for i = 0 To 3 'Anzahl der Eingabezellen -1
    With Sheets("Eingabemaske").Cells(6, 13 + i)
        if .Value = "" then
           Msgbox "Kein entsprechender Wert in Eingabemaske , Zelle " & .address(0, 0)
        else
            .copy Sheets("Checkliste").Cells(12 + i * 3, 9)
        end if
    end with
Next


gruß Daniel
slowboarder
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 24972
Registriert: 18. Apr 2009, 13:33

Re: mehrere Zellen auf inhalt prüfen

Beitragvon robigast » 16. Apr 2018, 20:44

Servus

Danke für dein positives Feedback.

In der Eingabemaske sind die Zellen nebeneinander wobei manche Zellen verbunden sind, und beim kopieren ins Tabellenblatt " Checkliste" sind sie untereinander aber nicht immer 3 Zeilen einmal sind es 7 oder 5 oder 1 usw.

Habe deinen Code versucht leider kann ich es nicht so umbauen Wie ich es brauchen würde.

Tabellenblatt "Eingabemaske" das geprüft werden soll wenn leer MSGBOX dann weiter zur nächsten, sind die Zellen = L6, M6, N6, O6, P6, Q6, R6, S6, T6, U6, V6, (W6+X6), (Y6+Z6), (AA6+AB6), (AC6+AD6), (AE6+AF6)

Tabellenblatt "Checkliste" hier soll kopiert werden = I12, I15, I18, I21, I23, I26, I28, I31, I33, I36, I38, I110, I131, I133, I135, I202

Wie in meinen geposteten Code der funktioniert.

lg robi
robigast
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 46
Registriert: 08. Apr 2018, 19:03

Re: mehrere Zellen auf inhalt prüfen

Beitragvon slowboarder » 16. Apr 2018, 21:35

sorry warum kommen jetzt plötzich diese Unregelmäßigkeiten?
schleifen kannst du dann verwenden, wenn die Abstände regelmäßig sind bzw aus dem Schleifenzähler nach einer regel berechnet werden können.
gibt es keine solche Regel, dann lässt sich der Code eben nicht verkürzen.

du könntest hier die Zellbereiche in zwei Arrays schreiben und darauf achten, dass die zueinander gehörenden Bereiche an der gleichen Stelle im Array stehen.

Code: Alles auswählen
Quelle = Array("L6", "O6", "W6:X6")
Ziel = Array("I12", "I15", "I18", "I110")
for i = 0 to ubound(Quelle)

With Sheets("Eingabemaske").Range(Quelle(i))
    if .Cells(1).Value = "" then
         Msgbox "...."
    else
        .Cells.Copy Sheets("Checkliste").Range(Ziel(i))
    end if
end with


die Arrays bitte entsprechend ergänzen.
das letzte Beispiel im Array zeigt, wie du die mehrzelligen (Verbundenen) bereiche angeben musst.
beim Zielbereich wird immer nur die linke obere Zelle angegeben.
und den Code bitte nicht kopieren, sondern verstehen und selber schreiben, ich hab jetzt nichts getestet oder auf Tipfehler geprüft.

Gruß Daniel
slowboarder
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 24972
Registriert: 18. Apr 2009, 13:33

Re: mehrere Zellen auf inhalt prüfen

Beitragvon robigast » 16. Apr 2018, 22:56

Servus

Danke für deine Unterstützung, die Unregelmäßigkeit kommt daher da ich im Tabellenblatt verschiedene Kontrollen tätige.

Einmal brauche ich mehr Testfelder und einmal weniger.

Werde es gleich testen.


Danke für deine Hilfe.

lg robi
robigast
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 46
Registriert: 08. Apr 2018, 19:03

Re: mehrere Zellen auf inhalt prüfen

Beitragvon robigast » 17. Apr 2018, 12:00

Servus

Hurra geschaft mit deiner Hilfe , anbei der Code der funktioniert.

Du als makro kenner, msgbox kommt auch alles perfekt, ist es noch möglich das wenn mehrere Zellen keinen Eintrag haben nur einmal die msgbox kommt. Derzeit kommt die msgbox bei jeder zelle.
Kann mann es so steueren das wenn er bei mehreren Zellen kein Eintrag hat das die msgbox trozdem nur 1 mal kommt.
Beispiel: Zelle L6 kein Eintrag, O6 kein Eintrag, U6 kein Eintrag = kommt 3 mal die msgbox

Code: Alles auswählen
Private Sub CommandButton14_Click()
Dim Quelle As Variant
Dim Ziel As Variant
Dim i As Integer
Quelle = Array("L6", "M6", "N6", "O6", "P6", "Q6", "R6", "S6", "T6", "U6", "V6", "W6:X6", "Y6:Z6", "AA6:AB6", "AC6:AD6", "AE6:AF6")
Ziel = Array("I12", "I15", "I18", "I21", "I23", "I26", "I28", "I31", "I33", "I36", "I38", "I110", "I131", "I133", "I135", "I202")
For i = 0 To UBound(Quelle)

With Sheets("Eingabemaske").Range(Quelle(i))
If .Cells(1).Value = "" Then
     MsgBox "Es fehlt ein oder mehrere Einträge, Bitte Eintragen"
Else
.Cells.Copy Sheets("Checkliste").Range(Ziel(i))
End If
End With
Next

End Sub


lg robi
robigast
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 46
Registriert: 08. Apr 2018, 19:03

Re: mehrere Zellen auf inhalt prüfen

Beitragvon slowboarder » 17. Apr 2018, 12:08

Hi

schreibe an der Stelle, an welcher die Messagbox kommt, die Meldungtexte (dh die Adressen der Zellen) in einen String.

dh
Code: Alles auswählen
If .Cells(1).Value = "" Then
     Fehlermeldung = Fehlermeldung & Cells(1).Address(0, 0) & " "
Else


Nach durchlauf der Schleife prüfst du dann, ob die Variable "Fehlermeldung" einen Text enthält und gibst diesen mit der entsprechenden Meldung aus:
Code: Alles auswählen
Next
if Fehlermeldung = "" then
    Msgbox "i.O. alles kopiert"
Else
    Msgbox "Folgende Zellen enthielten keine Werte:" & vbLf & Fehlermeldung
End If


Gruß Daniel
slowboarder
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 24972
Registriert: 18. Apr 2009, 13:33

Re: mehrere Zellen auf inhalt prüfen

Beitragvon robigast » 17. Apr 2018, 14:33

Servus
Danke für die Info, werde es heute im Nachtdienst gleich wieder versuchen.

Lg robi
robigast
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 46
Registriert: 08. Apr 2018, 19:03

Re: mehrere Zellen auf inhalt prüfen

Beitragvon robigast » 17. Apr 2018, 21:06

Hy

Habe es gerade versucht, komme aber auf keinen grünen zweig.
Es kommt die Meldung " i.o alles kopiert " 16 mal, und wenn Beispiel in Zelle P6 keine Zahl steht kommt die Meldung: " Folgende Zellen enthielten keine Werte: " und ab dann kommt nur mehr die zweite Meldung obwohl eine Zahl vorhanden ist.

Anbei der Code:
[code][/Private Sub CommandButton14_Click()
Dim Quelle As Variant
Dim Ziel As Variant
Dim i As Integer
Dim fehlermeldung As String
Quelle = Array("L6", "M6", "N6", "O6", "P6", "Q6", "R6", "S6", "T6", "U6", "V6", "W6:X6", "Y6:Z6", "AA6:AB6", "AC6:AD6", "AE6:AF6")
Ziel = Array("I12", "I15", "I18", "I21", "I23", "I26", "I28", "I31", "I33", "I36", "I38", "I110", "I131", "I133", "I135", "I202")
For i = 0 To UBound(Quelle)

With Sheets("Eingabemaske").Range(Quelle(i))
If .Cells(1).Value = "" Then
fehlermeldung = fehlermeldung & Cells(12, 6).Address(0, 0) & " "
Else
If fehlermeldung = "" Then
MsgBox "i.O. alles kopiert"
Else
MsgBox "Folgende Zellen enthielten keine Werte:" & vbLf & fehlermeldung
End If

.Cells.Copy Sheets("Checkliste Runde").Range(Ziel(i))
End If
End With
Next

End Subcode]

lg robi
robigast
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 46
Registriert: 08. Apr 2018, 19:03

Re: mehrere Zellen auf inhalt prüfen

Beitragvon slowboarder » 17. Apr 2018, 21:15

Nach Durchlauf der Schleife
slowboarder
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 24972
Registriert: 18. Apr 2009, 13:33

Re: mehrere Zellen auf inhalt prüfen

Beitragvon robigast » 17. Apr 2018, 21:18

Servus nochmal!

Habe es anders auch versucht ohne Erfolg, ich glaube ich verlaufe mich immer

Anbei der Code
[code]Private Sub CommandButton14_Click()
Dim Quelle As Variant
Dim Ziel As Variant
Dim i As Integer
Dim fehlermeldung As String
Quelle = Array("L6", "M6", "N6", "O6", "P6", "Q6", "R6", "S6", "T6", "U6", "V6", "W6:X6", "Y6:Z6", "AA6:AB6", "AC6:AD6", "AE6:AF6")
Ziel = Array("I12", "I15", "I18", "I21", "I23", "I26", "I28", "I31", "I33", "I36", "I38", "I110", "I131", "I133", "I135", "I202")
For i = 0 To UBound(Quelle)

With Sheets("Eingabemaske").Range(Quelle(i))
If .Cells(1).Value = "" Then
fehlermeldung = fehlermeldung & Cells(6, 12).Address(0, 0) & " "
fehlermeldung = fehlermeldung & Cells(6, 13).Address(0, 0) & " "
fehlermeldung = fehlermeldung & Cells(6, 14).Address(0, 0) & " "
fehlermeldung = fehlermeldung & Cells(6, 15).Address(0, 0) & " "
fehlermeldung = fehlermeldung & Cells(6, 16).Address(0, 0) & " "
fehlermeldung = fehlermeldung & Cells(6, 17).Address(0, 0) & " "
fehlermeldung = fehlermeldung & Cells(6, 18).Address(0, 0) & " "
fehlermeldung = fehlermeldung & Cells(6, 19).Address(0, 0) & " "
fehlermeldung = fehlermeldung & Cells(6, 20).Address(0, 0) & " "
fehlermeldung = fehlermeldung & Cells(6, 21).Address(0, 0) & " "
fehlermeldung = fehlermeldung & Cells(6, 22).Address(0, 0) & " "
fehlermeldung = fehlermeldung & Cells(6, 23).Address(0, 0) & " "
fehlermeldung = fehlermeldung & Cells(6, 24).Address(0, 0) & " "
fehlermeldung = fehlermeldung & Cells(6, 25).Address(0, 0) & " "
fehlermeldung = fehlermeldung & Cells(6, 26).Address(0, 0) & " "
fehlermeldung = fehlermeldung & Cells(6, 27).Address(0, 0) & " "
Else

If fehlermeldung = "" Then
MsgBox "i.O. alles kopiert"
Else
MsgBox "Folgende Zellen enthielten keine Werte:" & vbLf & fehlermeldung
End If

'If .Cells(1).Value = "" Then
'MsgBox "Es fehlt ein oder mehrere Einträge, Bitte Eintragen"

.Cells.Copy Sheets("Checkliste Runde").Range(Ziel(i))
End If
End With
Next

End Sub[code]

auch hier kommt die Meldung 16 mal.

lg robi
robigast
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 46
Registriert: 08. Apr 2018, 19:03

Re: mehrere Zellen auf inhalt prüfen

Beitragvon Nicolaus » 17. Apr 2018, 21:28

Hi Robi,

der zweite Codeschnipsel von Daniel muss unter dein "Next", das ist in dem Teil auch noch zu sehen.
Ich würde bei mehreren Fehlermeldungen auch noch einen Zeilenvorschub einfügen.
Code: Alles auswählen
Private Sub CommandButton14_Click()

Dim Quelle As Variant
Dim Ziel As Variant
Dim i As Integer
Dim fehlermeldung As String
Quelle = Array("L6", "M6", "N6", "O6", "P6", "Q6", "R6", "S6", "T6", "U6", "V6", "W6:X6", "Y6:Z6", "AA6:AB6", "AC6:AD6", "AE6:AF6")
Ziel = Array("I12", "I15", "I18", "I21", "I23", "I26", "I28", "I31", "I33", "I36", "I38", "I110", "I131", "I133", "I135", "I202")
For i = 0 To UBound(Quelle)
   
    With Sheets("Eingabemaske").Range(Quelle(i))
        If .Cells(1).Value = "" Then
            fehlermeldung = fehlermeldung & Chr(10) & .Address(0, 0) & " "
        Else
            .Cells.Copy Sheets("Checkliste Runde").Range(Ziel(i))
        End If
    End With
Next
If fehlermeldung = "" Then
 MsgBox "i.O. alles kopiert"
Else
 MsgBox "Folgende Zellen enthielten keine Werte:" & vbLf & fehlermeldung
End If
End Sub

Du hast im Quellarray auch einige Zellbereiche mit drin.
Ist dir klar, dass davon immer nur die erste Zelle geprüft wird ?

Gruß
Nic
die Forenhelfer freuen sich über eine Antwort
Benutzeravatar
Nicolaus
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 4585
Registriert: 02. Feb 2010, 15:52
Wohnort: Rhein Main Gebiet

Re: mehrere Zellen auf inhalt prüfen

Beitragvon robigast » 17. Apr 2018, 21:44

Servus Nic

Super Danke funktioniert, toll
Eure Hilfe hier im Forum ist Super..
Danke dir und Daniel für die Tolle Hilfe, bei manchen VBA Prozeduren geht es und manchmal eck es .


lg robi
robigast
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 46
Registriert: 08. Apr 2018, 19:03

Re: mehrere Zellen auf inhalt prüfen

Beitragvon robigast » 19. Apr 2018, 15:00

Hall grüß euch nochmal!

Der Code läuft prima top, würde es noch verfeinern habe schon einiges probiert kommen immer wieder fehler.

Möchte gerne wenn die Msgbox kommt bsp. (MsgBox "Folgende Zellen enthielten keine Werte L6 = Druckantsieg behälter 1") usw......für alle Quellen Felder
usw. Also möchte genre der Zelle bei der ausgabe einen Text hinzufügen.
Habe es schon versucht komme aber nicht auf meinen fehler drauf

so wollte ich es dazubasteln: habe es fett makiert.
Vielleicht geht auch nicht das man einen Text hinzufgen kann, oder einen Zellenverweis wo ein text enthalten ist.

Code: Alles auswählen
Sub RundeWerte()
Dim Text1 As String
Dim Quelle As Variant
Dim Ziel As Variant
[b]Dim vartext as Variant[/b]
Dim i As Integer
[b]Dim z as Integer[/b]
Dim fehlermeldung As String
Quelle = Array("L6", "M6", "N6", "O6", "P6", "Q6", "R6", "S6", "T6", "U6", "V6", "W6", "Y6", "AA6", "AC6", "AE6")
Ziel = Array("I12", "I15", "I18", "I21", "I23", "I26", "I28", "I31", "I33", "I36", "I38", "I110", "I131", "I133", "I135", "I202")
[b]vartext = Array("Hallo1","Hallo2",....usw.)[/b]
For i = 0 To UBound(Quelle)
   With Sheets("Eingabemaske").Range(Quelle(i))[b].Range(vartext(z))[/b]
       If .Cells(1).Value = "" Then
           fehlermeldung = fehlermeldung & Chr(10) & .Address(0, 0) & " "
        Else
           .Cells.Copy Sheets("Checkliste Runde").Range(Ziel(i))
        End If
    End With
Next
If fehlermeldung = "" Then
MsgBox "i.O. alle Werte wurden kopiert"
Else
MsgBox "Folgende Zellen enthielten keine Werte:" & vbLf & fehlermeldung
Text1 = "Die restlichen Werte wurden kopiert, "
MsgBox Text1, , "Information"
End If



besten Dank schon mal im vorraus.

lg robi, an einen so heißen April!!!
robigast
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 46
Registriert: 08. Apr 2018, 19:03

Re: mehrere Zellen auf inhalt prüfen

Beitragvon Nicolaus » 19. Apr 2018, 15:13

Hi robi,

meinst du so ?
Code: Alles auswählen
Sub RundeWerte()
Dim Text1 As String
Dim Quelle As Variant
Dim Ziel As Variant
Dim vartext As Variant
Dim i As Integer

Dim fehlermeldung As String
Quelle = Array("L6", "M6", "N6", "O6", "P6", "Q6", "R6", "S6", "T6", "U6", "V6", "W6", "Y6", "AA6", "AC6", "AE6")
Ziel = Array("I12", "I15", "I18", "I21", "I23", "I26", "I28", "I31", "I33", "I36", "I38", "I110", "I131", "I133", "I135", "I202")
vartext = Array("Hallo1", "Hallo2", "Hallo3", "Hallo4", "Hallo5", "Hallo6", "Hallo7", "Hallo8", "Hallo9", "Hallo10", "Hallo11", "Hallo12", "Hallo13", "Hallo14", "Hallo15", "Hallo16")
For i = 0 To UBound(Quelle)
   With Sheets("Eingabemaske").Range(Quelle(i))
       If .Cells(1).Value = "" Then
           fehlermeldung = fehlermeldung & Chr(10) & .Address(0, 0) & " = " & vartext(i)
        Else
           .Cells.Copy Sheets("Checkliste Runde").Range(Ziel(i))
        End If
    End With
Next
If fehlermeldung = "" Then
MsgBox "i.O. alle Werte wurden kopiert"
Else
MsgBox "Folgende Zellen enthielten keine Werte:" & vbLf & fehlermeldung
Text1 = "Die restlichen Werte wurden kopiert, "
MsgBox Text1, , "Information"
End If
End Sub
Gruß
Nic
die Forenhelfer freuen sich über eine Antwort
Benutzeravatar
Nicolaus
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 4585
Registriert: 02. Feb 2010, 15:52
Wohnort: Rhein Main Gebiet

Nächste

Zurück zu Excel Forum (provisorisch)

Wer ist online?

Mitglieder in diesem Forum: beneran, HKindler, KW2903, Robbi Dick und 22 Gäste