Bereich prüfen

Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Range("A8:A38"), Target) Is Nothing Then If WorksheetFunction.CountIf(Range("A8:A38"), "") > 0 Then MsgBox "Seite 1 noch frei!" Application.EnableEvents = False ElseIf Not Intersect(Range("H9:H38"), Target) Is Nothing Then Application.EnableEvents = True If WorksheetFunction.CountIf(Range("H9:H38"), "") > 0 Then MsgBox "Seite 2 voll!" Else MsgBox "Seite 2 noch frei!" End If End If End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean) 'Hier soll im Bereich "A8:A38" .... Dim x As Range If Range("H38") "" Then MsgBox "kein Platz mehr" Unload Me End If For Each x In Range("A8:A38, H9:H38") If x = "" Then 'alle werte in die eine Zelle! x = TextBox1 & TextBox2 & TextBox3 & TextBox4 Exit For End If Next Cancel = False UFBGOQ.TextBox1.SetFocus End Sub

Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean) Dim x As Range, cnt As Long Dim loletzte As Double Static mblnQueryClose As Boolean Dim sBereich As String sBereich = "A8:A38, H9:H38" If Not mblnQueryClose Then mblnQueryClose = True loletzte = WorksheetFunction.CountA(Range(sBereich)) If loletzte

Hallo zusammen
Ich habe mal einen Code zusammengestellt, wie ich mir das in etwa vorstelle. Doch beim zweiten Bereich fügt er mir die Werte immer in die gleichen Zellen. Was ist an diesem Code falsch?
Hoffe anhand diesen Zeilen kann mir jemand behilflich sein?
Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim ErsterBereich As Range
Dim ZweiterBereich As Range
If NoEX Then Exit Sub 'Für das vorzeitige Abbrechen
With Worksheets("Tabelle1").Range("A8:A38")
Set ErsterBereich = .Find(What:="", After:=.Cells(.Cells.Count), LookIn:=xlFormulas, LookAt:=xlWhole)
End With
If Not ErsterBereich Is Nothing Then
Worksheets("Tabelle1").Cells(ErsterBereich.Row, 1) = TextBox1.Value
Worksheets("Tabelle1").Cells(ErsterBereich.Row, 2) = TextBox4.Value
Cancel = False
Set TextBox = TextBox1
Call Application.OnTime(EarliestTime:=Now, Procedure:="SetFocus_TextBox")
Else
With Worksheets("Tabelle1").Range("H9:H38")
Set ZweiterBereich = .Find(What:="", After:=.Cells(.Cells.Count), LookIn:=xlFormulas, LookAt:=xlWhole)
End With
If Not ZweiterBereich Is Nothing Then
Worksheets("Tabelle1").Cells(ZweiterBereich.Row, 10) = TextBox1.Value
Worksheets("Tabelle1").Cells(ZweiterBereich.Row, 11) = TextBox4.Value
Else
MsgBox "Keine freie Zelle im Bereich gefunden!"
NoEX = True 'Für das vorzeitige Abbrechen
Unload Me
End If
End If
Gruss Daniel

Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean) Dim x As Range, i As Long, aArea As Range Dim sBereich As String Static mblnQueryClose As Boolean Dim arrTmp Dim sGibtsschon As String sBereich = "A8:A38, H9:H38" If Not mblnQueryClose Then mblnQueryClose = True 'forschleife zur Prüfung ob schon vorhanden 'Aufteilung in die beiden Areas wegen dem Array For Each aArea In Range(sBereich).Areas ' bereich vergrößern damit alle Spaltenwerte des einen Bereiches verglichen werden arrTmp = aArea.Resize(, 4) 'untere Schleifengrenze festlegen i = LBound(arrTmp, 1) Do While i

Beliebteste Forumthreads (12 Monate)

19
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Bereich prüfen

19 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

19
Beiträge zum Forumthread

Beiträge zu diesem Forumthread