Microsoft Excel – die neusten Beiträge

VBA Intersect Bereich in Bereich überprüfen statt Zelle in Bereich?

Hallo,

wie kann ich mit der Methode Application.Intersect zwei Bereiche miteinander Vergleichen?

Normalerweise kann ich ja z.b. mit :

If Not Application.Intersect(Target, Bereich) Is Nothing Then
Msg "Nicht innerhalb"

Überprüfen ob eine Zelle in einem benannten Bereich ausgewählt oder sontiges ist.

Das klappt mit:

If Not Application.Intersect(Selection.Address, Bereich) Is Nothing Then
Msg "Nicht innerhalb"

leider nur mittelmäßig.

Beispiel:

'''''''''''''''''''''''''''''''''''''1.
Set Bereich = Range("B1:B10")

'Ich markiere Zelle B1 bis B2 

If Not Application.Intersect(Selection.Address, Bereich) Is Nothing Then
Msg "Nicht innerhalb"

'Ergebnis = Keine MsgBox - richtig

'''''''''''''''''''''''''''''''''''''2.
Set Bereich = Range("B1:B10")

'Ich markiere Zelle A1 bis A10  

If Not Application.Intersect(Selection.Address, Bereich) Is Nothing Then
Msg "Nicht innerhalb"

'Ergebnis = MsgBox erscheint - richtig

'''''''''''''''''''''''''''''''''''''3.
Set Bereich = Range("B1:B10")

'Ich markiere Zelle A1 bis B1  

If Not Application.Intersect(Selection.Address, Bereich) Is Nothing Then
Msg "Nicht innerhalb"

'Ergebnis = keine MsgBox - falsch, das soll nicht passieren

'''''''''''''''''''''''''''''''''''''4.
Set Bereich = Range("B1:B10")

'Ich markiere Zelle A1 bis C1  

If Not Application.Intersect(Selection.Address, Bereich) Is Nothing Then
Msg "Nicht innerhalb"

'Ergebnis = keine MsgBox - falsch, das soll nicht passieren

'''''''''''''''''''''''''''''''''''''4.
Set Bereich = Range("B1:B10")

'Ich markiere Zelle B1 bis B15  

If Not Application.Intersect(Selection.Address, Bereich) Is Nothing Then
Msg "Nicht innerhalb"

'Ergebnis = keine MsgBox - falsch, das soll nicht passieren

Wie schaff ich es, dass die MsgBox immer dann auftaucht, wenn mindestens eine Zelle nicht im Bereich ist?
Also der Markierte Bereich MUSS mit jeder Zelle im Definierten Bereich liegen.

Und eine Lösung ohne 'Split' oder Umwege wäre mir lieb, außer es gibt halt keine andere xD

PC, Computer, Microsoft Excel, programmieren, VBA, VBA Programmierung, Range, VBA Excel

VBA Laufzeitfehler/ Error/ Programm hängt sich auf?

Hallo zusammen,

Ich habe ein Makro geschrieben, mit welchem jeweils via Button eine neue Spalte eingefügt wird.

Über den Button Spalten entfernen wird die jeweils ausgewählte Spalte gelöscht.

Private Sub CmdSpaltePlus_Click() 'Test Spalte hinzufügen

Dim spalte, zeile As Integer

Application.ScreenUpdating = False

spalte = 4

Do Until Cells(2, spalte).Value = "Perfektion"

   spalte = spalte + 1

Loop

Columns("D:E").Copy

Columns(spalte).Insert Shift:=xlToRight

Range(Cells(2, spalte - 2), Cells(2, spalte + 1)).Merge

Range(Cells(4, spalte), Cells(4, spalte + 1)).Merge

Cells(3, spalte).Value = ""

Cells(3, spalte + 1).Value = ""

Cells(4, spalte).Value = ""

Cells(4, spalte + 1).Value = ""

zeile = 6

 

Do Until zeile = 1000

   If Left(Cells(zeile, 1).Value, 1) = "S" Then

        Cells(zeile, spalte).Value = ""

       Cells(zeile, spalte + 1).Value = ""

    End If

   zeile = zeile + 1

Loop

Application.ScreenUpdating = True

End Sub

 

Private Sub CmdPerfektionPlus_Click() 'Perfektion Spalte hinzufügen

Dim spalte, zeile As Integer

Application.ScreenUpdating = False

spalte = 4

Do Until Cells(2, spalte).Value = "F.n.B."

   spalte = spalte + 1

Loop

Columns("D:E").Copy

Columns(spalte).Insert Shift:=xlToRight

Range(Cells(2, spalte - 2), Cells(2, spalte + 1)).Merge

Range(Cells(4, spalte), Cells(4, spalte + 1)).Merge

Cells(3, spalte).Value = ""

Cells(3, spalte + 1).Value = ""

Cells(4, spalte).Value = ""

Cells(4, spalte + 1).Value = ""

zeile = 6

Do Until zeile = 1000

   If Left(Cells(zeile, 1).Value, 1) = "S" Then

        Cells(zeile, spalte).Value = ""

       Cells(zeile, spalte + 1).Value = ""

    End If

   zeile = zeile + 1

Loop

Application.ScreenUpdating = True

End Sub

Spalten löschen

Private Sub Kompetenzenentfernen_Click() 'Spalten löschen

ActiveSheet.Unprotect Password:="MNPS"

If Cells(5, ActiveCell.Column) = "Schicht" Or Cells(5, ActiveCell.Column) = "Nr." Or Cells(5, ActiveCell.Column) = "Name" Or Cells(3, ActiveCell.Column) = "A1" Or Cells(3, ActiveCell.Column) = "D1" Or Cells(9, ActiveCell.Column) = "." Or Cells(3, ActiveCell.Column) = "E1" Or Cells(3, ActiveCell.Column) = "F1" Or Cells(3, ActiveCell.Column) = "G1" Or Cells(3, ActiveCell.Column) = "H1" Or Cells(2, ActiveCell.Column) = "." Or Cells(1, ActiveCell.Column) = "Zielwert" Then

MsgBox "Spalte kann nicht gelöscht werden"

Else

Selection.EntireColumn.Delete Shift:=xlUp

End If

'ActiveSheet.Protect Password:="MNPS"

End Sub

Die Buttons funktionieren auch alle, nur leider kommt oft eine Laufzeitfehlerneldung oder das ganze Programm hängt sich auf wenn ich erst mit dem einen Button eine Spalte eingefügt habe und im Anschluss mit dem anderen Button eine Spalte einfügen.

Es funktioniert also leider nicht verlässlich. Hat jemand eine Idee woran das liegen könnte?

Vielen Dank im Voraus!

Bild zum Beitrag
Microsoft Excel, VBA

VBA Message-Box mit zwei Bedingungen?

Hallo zusammen,

ich versuche eine Message-Box in Excel zu erzeugen, die beim Wechsel eines Worksheets bald fällige bzw. überfällige Termine anzeigt. Dabei stehen die Fälligkeiten in der Spalte K. Eine solche Meldung soll allerdings unterbleiben, sofern der Bearbeitungsstand auf "abgeschlossen" gesetzt wurde. Der Bearbeitungsstand wird in der Spalte N mittels Dropdown-Liste erfasst.

Mein Code sieht folgendermaßen aus:

Private Sub Worksheet_Activate()

 Dim rDatTermin

 Dim rDatStand

 Dim sMsgBaldFaellig As String

 Dim sMsgUeberFaellig As String

 Dim sMsgAbgeschlossen As String

 sMsgBaldFaellig = ""

 sMsgUeberFaellig = ""

 For Each rDatTermin In Range("K4:K500")

   If rDatTermin.Value <> "" Then

     If rDatTermin.Value < Date Then

       sMsgUeberFaellig = sMsgUeberFaellig & Cells(rDatTermin.Row, 2) & vbCrLf

     Else

       If rDatTermin.Value <= Date + 14 Then _

         sMsgBaldFaellig = sMsgBaldFaellig & Cells(rDatTermin.Row, 2) & vbCrLf

     End If

   End If

   Next

 For Each rDatStand In Range("N4:N500")

   If rDatStand.Value <> "" Then

     If rDatStand.Value = "abgeschlossen" Then _

       sMsgAbgeschlossen = 1

     End If

   Next

 If sMsgUeberFaellig & sMsgBaldFaellig <> "" & sMsgAbgeschlossen <> 1 Then

   MsgBox "Überfällig" & vbCrLf & vbCrLf & sMsgUeberFaellig & "Bald fällig" & vbCrLf & sMsgBaldFaellig

 End If

End Sub

Offensichtlich klappt hier die Verknüpfung zur zweiten Bedingung noch nicht. Die erste Bedingung wird geprüft und korrekt angezeigt. Der Bearbeitungsstand wird dabei jedoch nicht berücksichtigt. Wo habe ich da meinen Gedankenfehler?

Computer, Microsoft Excel, VBA

Mehrere MsgBox-Abfragen hintereinander möglich?

Hallo, da hier doch so viele Könner unterwegs sind: Ich hänge schon wieder fest.

Ich habe zwei msg-Boxen vbYesNoCancel. Wenn die erste Box mit Ja bestätigt wird, wird eine Prozedur gestartet.
Wenn ich den Button Abbrechen klicke, soll die zuletzt geöffnete Userform neu geladen und die Sub beendet werden.

Wenn ich den Nein Button klicke öffnet sich die nächste msg Box vbYesNoCancel.
Wenn nun Ja geklickt wird, wird wieder eine Prozedur gestartet, beim Abbrechen wieder die Userform neu geladen und die Sub beendet.
Und bei Nein wird eine weitere Prozedur gestartet.

Eigentlich dürfte es ja nicht schwer sein, aber bei mir hängt es. Die Userform wird neu geladen aber die nächste msg Box öffnet nur und dann passiert nichts, wenn ich dort einen Button klicke.

So sieht es nun aus (und vielen Dank im Voraus):

Public Sub InspectionCriterion()
    Dim msg As String, msg2 As String, msg3 As String
    msg = MsgBox("Ist das Merkmal ein Gewinde?", vbYesNoCancel + vbQuestion, "")
    


    If msg = vbYes Then
    UserFormThread.Show
    ElseIf msg = vbNo Then
    msg2 = MsgBox("Ist das Merkmal zu messen?", vbYesNoCancel + vbQuestion, "")
    ElseIf msg = vbCancel Then
    Call InspectionFeatures
    Exit Sub
    


    If msg2 = vbYes Then
    UserFormDimension.Show
    ElseIf msg2 = vbNo Then UserFormText.Show
    Else
    Exit Sub
    End If
    End If
    
    
End Su  
Computer, Microsoft Excel, VBA Excel

Meistgelesene Beiträge zum Thema Microsoft Excel