Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1400to1404
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Spaltenabfrage bei einfügen von Daten
05.01.2015 01:08:48
Daten
Hallo Leute
Ich hab jetzt x Varianten probiert aber nichts funktioniert.
Ich kopiere Daten und füge sie in eine Tabelle ein. Das Ziel wähle ich mitels Inputbox aus. Das Klappt alles wunderbar, nun möchte ich aber das man nur eine Zelle in Spalte F auswählen kann. wenn man was anderes auswählt soll eine MSGbox kommen.
Kann mir bitte einer helfen, ich weiss mir kein Rat mehr.
Hier mal der Code:
Sub Artikel_Kopieren_Türenartikel()
'Kopieren der Materialien in die Möbelspalte mit Abfrage und Kontrolle das die spalten ausgewä _
hlt wurden
Dim objTargetRange As Range, objCopyRange As Range
Dim objRangeCollection As Collection
If TypeOf Selection Is Range Then
Set objCopyRange = Selection
If VerifySelection(objCopyRange) Then
Set objRangeCollection = New Collection
Worksheets("Möbel").Select
Do
objRangeCollection.Add Application.InputBox(Prompt:= _
"Bitte die Zielzelle markieren In Spalte F (Menge).", Title:="Auswahl",  _
Type:=8)
If TypeOf objRangeCollection(objRangeCollection.Count) Is Range Then
Set objTargetRange = objRangeCollection(objRangeCollection.Count)
Exit Do
ElseIf IsEmpty(objRangeCollection(objRangeCollection.Count)) Then
Call MsgBox("Objektzuweisung fehlgeschlagen. Bitte nochmal versuchen", _
vbCritical, "Objektfehler")
ElseIf Not objRangeCollection(objRangeCollection.Count) Then
Exit Sub 'cancelbutton pressed
Else
Call MsgBox("Fehler " & CStr(vbObjectError) & vbLf & vbLf & _
"Unbekannter Objektfehler beim Zuweisen eines Bereiches.", _
vbCritical, "Objektfehler")
Exit Sub
End If
Loop
Call objCopyRange.Copy
Call objTargetRange.Cells(1, 1).PasteSpecial(Paste:=xlPasteValues)
If MsgBox("Noch ein Material Auswählen?", vbYesNo Or vbQuestion, "Abfrage") = vbYes  _
Then
Sheets("Artikel Türen").Select
Application.CutCopyMode = False
End If
End If
Set objCopyRange = Nothing
Set objTargetRange = Nothing
Set objRangeCollection = Nothing
End If
End Sub
Private Function VerifySelection(ByRef probjCopyRange As Range) As Boolean
Dim lngRow As Long
VerifySelection = True
With probjCopyRange
If Not Intersect(.Cells, Columns("E:m")) Is Nothing Then
If Intersect(.Cells, Columns("E:m")).Count = .Count Then
For lngRow = .Row To .Row + .Rows.Count - 1
If Intersect(.Cells, Range(Cells(lngRow, 5), Cells(lngRow, 13))).Count  9  _
_
Then
Call MsgBox("Bitte nur ganze Zeilen in den Spalten E-M markieren. (Rote  _
_
Bereich)", _
vbExclamation, "Hinweis")
VerifySelection = False
Exit For
End If
Next
Else
Call MsgBox("Bitte nur Zellen in den Spalten E-M markieren. (Rote Bereich)", _
vbExclamation, "Hinweis")
VerifySelection = False
End If
Else
Call MsgBox("Bitte nur Zellen in den Spalten E-M markieren. (Rote Bereich)", _
vbExclamation, "Hinweis")
VerifySelection = False
End If
End With
End Function

Hier ist der Bereich wo ich die zeile zum einfügen auswähle inkl. abfragen ob sie Leer ist,...
Worksheets("Möbel").Select
Do
objRangeCollection.Add Application.InputBox(Prompt:= _
"Bitte die Zielzelle markieren In Spalte F (Menge).", Title:="Auswahl",  _
Type:=8)
If TypeOf objRangeCollection(objRangeCollection.Count) Is Range Then
Set objTargetRange = objRangeCollection(objRangeCollection.Count)
Exit Do
ElseIf IsEmpty(objRangeCollection(objRangeCollection.Count)) Then
Call MsgBox("Objektzuweisung fehlgeschlagen. Bitte nochmal versuchen", _
vbCritical, "Objektfehler")
ElseIf Not objRangeCollection(objRangeCollection.Count) Then
Exit Sub 'cancelbutton pressed
Else
Call MsgBox("Fehler " & CStr(vbObjectError) & vbLf & vbLf & _
"Unbekannter Objektfehler beim Zuweisen eines Bereiches.", _
vbCritical, "Objektfehler")
Exit Sub
End If
Loop

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Spaltenabfrage bei einfügen von Daten
05.01.2015 07:53:47
Daten
Ach hallo,
ein Ansatz:
Tabelle1.Unprotect ""
Tabelle1.Cells.Locked = True
Tabelle1.Columns(6).Locked = False
Tabelle1.EnableSelection = xlUnlockedCells
Tabelle1.Protect ""

Gruß Gerd

AW: Spaltenabfrage bei einfügen von Daten
05.01.2015 12:55:21
Daten
Hallo Gerd
Danke für den Tip.
An das Speeren der Zellen an das habe ich nicht gedacht, das ist noch besser jetzt kann ich auch gleich den einfüge bereich damit festlegen und sobald er den zu einfügenden bereich überschreitet ne MSGBOX bring.
Vielen Vielen Dank
Eine Frage habe ich noch gibt es eine Variante um solche Range zu vereinfachen oder muss ich die immer so angeben?
Sheets("Möbel").Cells.Locked = True
Sheets("Möbel").Range("F8:f37,F41:f70,F74:f103,F107:f136,F140:f169,F173:f202,F206:  _
_
f235,F239:f268,F272:f301,F305:f334,F338:f367,F371:f400,F404:f433,F437:f466,F470:f499,F503:f532,  _
_F536:f565,F569:f598,F602:f631,F635:f664,F668:f697,F701:f730,F734:f763,F767:f796").Locked = False
'Sheets("Möbel").Columns(6).Locked = False    
Sheets("Möbel").Range("F8:n37,F41:n70,F74:n103,F107:n136,F140:n169,F173:n202,F206:n235,F239:n268, _ F272:n301,F305:n334,F338:n367,F371:n400,F404:n433,F437:n466,F470:n499,F503:n532,F536:n565,F569:n598, _ F602:n631,F635:n664,F668:n697,F701:n730,F734:n763,F767:n796").Locked = False
mfg
LAser

Anzeige
Ja, aber nur 1x, wenn du eine Konstante ...
06.01.2015 05:04:13
Luc:-?
…damit belegst (b.Bedarf auch global), Laser:
Const adRelBer$ = "F8:N37,F41:N70,F74:N103,F107:N136,F140:N169,F173:N202,F206:N235,F239:N268," & _ "F272:N301,F305:N334,F338:N367,F371:N400,F404:N433,F437:N466,F470:N499,F503:N532,F536:N565," & _
"F569:N598,F602:N631,F635:N664,F668:N697,F701:N730,F734:N763,F767:N796"

Außerdem kannst du dann im jeweiligen Pgm 1malig eine Range-Variable belegen:
Dim relBer As Range
Set relBer = Sheets("Möbel").Range(adRelBer)

Am PgmEnde diese Variable aber wieder freigeben:
Set relBer = Nothing
Gruß, Luc :-?

Anzeige
AW: Ja, aber nur 1x, wenn du eine Konstante ...
06.01.2015 20:47:39
Laser
Hallo Luc
Cool danke das kannte ich noch nicht.
Also Pro Sheet kann ich das nur 1mal verwenden oder kann ich das nur Global 1 mal verwenden?
mfg
Laser

AW: Ja, aber nur 1x, wenn du eine Konstante ...
06.01.2015 21:30:39
Daniel
Hi
wenn du auf mehreren Blättern immer den selben Zellbereich ansprechen willst, dann kannst du bei dieser Variante die Konstante auch frü mehrere Blätter verwenden:
Sheets("Möbel").Range(adRelBer)
Sheets("Bodenbeläge").Range(adRelBer)
allerdings hat diese Methode den Nachteil, dass der String nicht länger als 256 Zeichen lang sein darf, dh wenn weitere Zellbereiche hinzukommen, wirds eng.
da aber eine Regelmässigkeit besteht, kannst du die Zuweisung zu einer Range-Variablen in einer Schleife durchführen:
Dim relBer As Range
Dim i As Long
Set relBer = Sheets("Möbel").Cells(8, 6).Resize(30, 9)
For i = 41 To 767 Step 33
Set relBer = Union(relBer, Sheets("Möbel").Cells(i, 6).Resize(30, 9))
Next
in der folge arbeitest du dann mit relBer als Range-Variable.
Die ist dann aber fest an das Blatt "Möbel" gebunden, dh wenn du mit mehrern Blättern arbeitest, müsstest du für jedes eine eigene Range-Variable erstellen.
Gruß Daniel

Anzeige
AW: Ja, aber nur 1x, wenn du eine Konstante ...
07.01.2015 20:11:33
Laser
Hallo Daniel
Danke das ist mal cool.
Denn Code kann ich sogar öfter bei mir einsetzen hab da noch ein paar andere codes wo ich diesen verkürzen kann voralem ist dann das noch leichter ausbaufähig.
Vielen dank für die Hilfe
mfg
Laser

AW: Ja, aber nur 1x, wenn du eine Konstante ...
07.01.2015 20:11:49
Laser
Hallo Daniel
Danke das ist mal cool.
Denn Code kann ich sogar öfter bei mir einsetzen hab da noch ein paar andere codes wo ich diesen verkürzen kann voralem ist dann das noch leichter ausbaufähig.
Vielen dank für die Hilfe
mfg
Laser

305 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige