Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1576to1580
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
Inhaltsverzeichnis

Freie Zelle suchen und füllen

Freie Zelle suchen und füllen
05.09.2017 15:35:21
Nadine
Hallo zusammen,
bis auf das fettgeschriebene funktioniert der Code.
Allerdings weiss ich nicht so ganz genau, wie ich das optimal löse.
Ich suche im ref_feld1 nach wnr im Bereich D9:D12.
Wenn in diesem Bereich keine wnr gefunden wird, soll die eingegeben Nummer in einer freien zelle erscheinen. 4 Plätze sind verfügbar, wenn alle belegt sind, soll eine MsgBox erscheinen.
Dim ref_feld1 As Object, wnr As Variant, menge As Variant
Set ref_feld1 = Worksheets("Lagerverwaltung").Range("D9:D12").Find(what:=wnr)
If ref_feld1 Is Nothing Then
[Suche die nächste freie zelle im Bereich und trage die wnr ein, wenn kein freier PLatz mehr]
MsgBox "Lagerplatz voll!"

Else
'If Not ref_feld1 Is Nothing Then
ref_feld1.Offset(0, 1) = ref_feld1.Offset(0, 1).Value + menge
Jemand eine kleine Idee?
Dank Euch!
Lg, Nadine

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Freie Zelle suchen und füllen
05.09.2017 15:40:52
Werner
Hallo Nadine,
wnr und menge sind Variablen, denen du, zumindest bei deinem hier gezeigten Code, keinen Wert zuweist. Nach was soll er denn dann suchen, wenn wnr keinen Wert hat?
Es wäre besser, wenn du eine Beispielmappe mit Dummy-Daten hier hochladen würdest, in der du dann auch aufzeigst, was dein Wunschergebnis wäre.
Gruß Werner
AW: Freie Zelle suchen und füllen
05.09.2017 18:28:28
Peter
Hallo,
hier ein kleiner code ohne .Find

Option Explicit
Public Sub WnrToSheet()
Dim wnr As Variant, sum As Variant
Dim rng As Range, c As Object
Dim ws As Worksheet
Dim counter As Integer
sum = 102293
wnr = "test"
Set ws = ThisWorkbook.Sheets("Lagerverwaltung")
With ws
Set rng = .Range(.Cells(9, 4), .Cells(12, 4))
For Each c In rng
If c.Value = "" Then
c.Value = wnr
Exit For
ElseIf c.Value  "" Then
If c.Value = wnr Then
c.Offset(, 1).Value = c.Offset(, 1).Value + sum
counter = counter + 1
Else
counter = counter + 1
End If
End If
Next c
If counter = rng.Rows.Count Then MsgBox "Lagerplatz voll"
End With
End Sub
Leider ist nicht wirklich verständliche was du eigentlich brauchst oder willst...
eine Beispiel Mappe wäre Super.
Vielleicht kannst du ja mit dem obigen Code trotzdem was anfangen.
Ich finde, dass Range.Find hier völlig fehl am platz ist.
.Find macht Sinn wenn du dann auch die entsprechende Zelle verändern willst,
ansonsten hat .Find wenig Anwendung...
(.Find gut für: Suchen u. Ersetzen, "Datensatz" finden, Werte in reihe verändern,
Suchwert zählen)
Anzeige
AW: Freie Zelle suchen und füllen
06.09.2017 07:04:24
Nadine
Hallo,
anbei mal die Bsp.-Datei:
https://www.herber.de/bbs/user/116027.xlsm
ich werd währenddessen aber schonmal versuchen die vorgeschlagenen Codes zum Laufen zu bringen.
Dank euch!
Lg, Nadine
AW: Freie Zelle suchen und füllen
06.09.2017 09:30:35
Nadine
Hallo nochmal,
also ich hab den Code jetzt eingesetzt:
https://www.herber.de/bbs/user/116030.xlsm
Der Code funktioniert soweit recht gut, bis auf eine Kleinigkeit.
Es wird quasi nicht gesucht, ob die eingegebenen wnr schon in dem Bereich exisitiert, damit nur noch die Menge addiert werden muss.
wie kann ich das am einfachsten lösen?
Dankeee!
lg, nadine
Anzeige
AW: Freie Zelle suchen und füllen
06.09.2017 15:16:45
Peter
Hallo,
anbei deine Mappe mit anderem Code.
Ich habe mir auch die Freiheit genommen, die UF Farbig zu machen.
Es sah im Code danach aus als ob du dass auch noch machen möchtest später,
vielleicht hift dir ja der Code im UserForm_Initialize event was.
Der neue Code, sucht nur einmal wnr im Bereich und ergänzt bzw. fügt auch nur einmal hinzu
Einfach mal ausprobieren und durchlesen.
Wenn du was im Code nicht verstehst, dann sag bescheid.
Hier Mappe: https://www.herber.de/bbs/user/116042.xlsm
Hier nur Code wer nichts runterladen will:

Option Explicit
Private worksheet_ As Worksheet
Private Const myRed As Long = &HA41C37
Private Const myGreen As Long = &H1CA41C
Private Const myWhite As Long = &HFFFFFF
Private Sub UserForm_Initialize()
Dim ctl As Control
Dim tb As MSForms.TextBox
Dim lbl As MSForms.Label
Me.BackColor = myGreen
For Each ctl In Me.Controls
If TypeOf ctl Is MSForms.Label Then
Set lbl = ctl
lbl.BackColor = myRed
lbl.ForeColor = myWhite
ElseIf TypeOf ctl Is MSForms.TextBox Then
Set tb = ctl
tb.BackColor = myGreen
tb.ForeColor = myWhite
End If
Next ctl
End Sub
Private Sub CommandButton1_Click()
ChangeSheet
End Sub
'// Sucht wnr, falls vorhanden, wird die Zelle links neben wnr verändert
'// falls nicht gefunden, wird wnr hinzugefügt
Private Sub ChangeSheet()
Dim array_() As Variant, cell_ As Variant
Dim thisRow As Long, thisColumn As Long
Dim rowArray() As Long, wnrRow As Long
Dim amount As Variant, wnr As String
wnr = TextBox2.Value
amount = TextBox3.Value
array_ = SplitValues(ComboBox5.Value)
If IsEmpty(array_) Then Exit Sub
Set worksheet_ = ThisWorkbook.Sheets("Lagerverwaltung")
ReDim rowArray(1 To 3): rowArray(1) = 6: rowArray(2) = 4: rowArray(3) = 2
'//Alt
thisRow = DefineRange(array_(1))
thisColumn = rowArray(array_(0))
wnrRow = FindWNR(wnr, thisRow, thisColumn)
If wnrRow  0 Then
ChangeOffsetCell wnrRow, thisColumn + 1, amount
Else
If AddWNR(thisRow, thisColumn, wnr) = False Then MsgBox "Lagerplatz ist voll!"
End If
Erase array_
array_ = SplitValues(ComboBox6.Value)
If IsEmpty(array_) Then Exit Sub
'//Neu
thisRow = DefineRange(array_(1))
thisColumn = rowArray(array_(0))
wnrRow = FindWNR(wnr, thisRow, thisColumn)
If wnrRow  0 Then
ChangeOffsetCell wnrRow, thisColumn + 1, amount
Else
If AddWNR(thisRow, thisColumn, wnr) = False Then MsgBox "Lagerplatz ist voll!"
End If
End Sub
'// Teile den übergebenden Wert auf und speichere die teile in einem Array
Private Function SplitValues(ByVal splitThis As String) As Variant
Dim array_ As Variant
Dim i As Long
ReDim array_(1)
For i = 1 To Len(splitThis)
If IsNumeric(Mid(splitThis, i, 1)) Then
array_(0) = array_(0) & Mid(splitThis, i, 1)
Else
array_(1) = array_(1) & Mid(splitThis, i, 1)
End If
Next i
SplitValues = array_
End Function
'// Ermittle die Zeile des gesuchten Begriffes
Private Function DefineRange(ByVal findMe As String) As Long
Dim rng As Range, c
With worksheet_
Set rng = .Range(.Cells(3, 1), .Cells(44, 1))
Set c = rng.Find(findMe, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then DefineRange = c.Row
End With
Set c = Nothing
Set rng = Nothing
End Function
'// Finde Wnr in Bereich
Private Function FindWNR(ByVal wnr As String, ByVal whereRow As Long, ByVal whereColumn As Long) _
As Long
Dim rng As Range, c
With worksheet_
Set rng = .Range(.Cells(whereRow, whereColumn), .Cells(whereRow + 3, whereColumn))
Set c = rng.Find(wnr, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then FindWNR = c.Row
End With
Set c = Nothing
Set rng = Nothing
End Function
'// Ändere die Zelle links neben Wnr
Private Sub ChangeOffsetCell(ByVal whereRow As Long, ByVal whereColumn As Long, ByVal amount As  _
Variant)
Dim cell_
Set cell_ = worksheet_.Cells(whereRow, whereColumn)
If cell_.Value > 0 Then
cell_.Value = cell_.Value - amount
ElseIf cell_.Value = 0 Then
cell_.ClearContents
ElseIf cell_.Value 

Anzeige
AW: Freie Zelle suchen und füllen
06.09.2017 15:16:59
Peter
Hallo,
anbei deine Mappe mit anderem Code.
Ich habe mir auch die Freiheit genommen, die UF Farbig zu machen.
Es sah im Code danach aus als ob du dass auch noch machen möchtest später,
vielleicht hift dir ja der Code im UserForm_Initialize event was.
Der neue Code, sucht nur einmal wnr im Bereich und ergänzt bzw. fügt auch nur einmal hinzu
Einfach mal ausprobieren und durchlesen.
Wenn du was im Code nicht verstehst, dann sag bescheid.
Hier Mappe: https://www.herber.de/bbs/user/116042.xlsm
Hier nur Code wer nichts runterladen will:

Option Explicit
Private worksheet_ As Worksheet
Private Const myRed As Long = &HA41C37
Private Const myGreen As Long = &H1CA41C
Private Const myWhite As Long = &HFFFFFF
Private Sub UserForm_Initialize()
Dim ctl As Control
Dim tb As MSForms.TextBox
Dim lbl As MSForms.Label
Me.BackColor = myGreen
For Each ctl In Me.Controls
If TypeOf ctl Is MSForms.Label Then
Set lbl = ctl
lbl.BackColor = myRed
lbl.ForeColor = myWhite
ElseIf TypeOf ctl Is MSForms.TextBox Then
Set tb = ctl
tb.BackColor = myGreen
tb.ForeColor = myWhite
End If
Next ctl
End Sub
Private Sub CommandButton1_Click()
ChangeSheet
End Sub
'// Sucht wnr, falls vorhanden, wird die Zelle links neben wnr verändert
'// falls nicht gefunden, wird wnr hinzugefügt
Private Sub ChangeSheet()
Dim array_() As Variant, cell_ As Variant
Dim thisRow As Long, thisColumn As Long
Dim rowArray() As Long, wnrRow As Long
Dim amount As Variant, wnr As String
wnr = TextBox2.Value
amount = TextBox3.Value
array_ = SplitValues(ComboBox5.Value)
If IsEmpty(array_) Then Exit Sub
Set worksheet_ = ThisWorkbook.Sheets("Lagerverwaltung")
ReDim rowArray(1 To 3): rowArray(1) = 6: rowArray(2) = 4: rowArray(3) = 2
'//Alt
thisRow = DefineRange(array_(1))
thisColumn = rowArray(array_(0))
wnrRow = FindWNR(wnr, thisRow, thisColumn)
If wnrRow  0 Then
ChangeOffsetCell wnrRow, thisColumn + 1, amount
Else
If AddWNR(thisRow, thisColumn, wnr) = False Then MsgBox "Lagerplatz ist voll!"
End If
Erase array_
array_ = SplitValues(ComboBox6.Value)
If IsEmpty(array_) Then Exit Sub
'//Neu
thisRow = DefineRange(array_(1))
thisColumn = rowArray(array_(0))
wnrRow = FindWNR(wnr, thisRow, thisColumn)
If wnrRow  0 Then
ChangeOffsetCell wnrRow, thisColumn + 1, amount
Else
If AddWNR(thisRow, thisColumn, wnr) = False Then MsgBox "Lagerplatz ist voll!"
End If
End Sub
'// Teile den übergebenden Wert auf und speichere die teile in einem Array
Private Function SplitValues(ByVal splitThis As String) As Variant
Dim array_ As Variant
Dim i As Long
ReDim array_(1)
For i = 1 To Len(splitThis)
If IsNumeric(Mid(splitThis, i, 1)) Then
array_(0) = array_(0) & Mid(splitThis, i, 1)
Else
array_(1) = array_(1) & Mid(splitThis, i, 1)
End If
Next i
SplitValues = array_
End Function
'// Ermittle die Zeile des gesuchten Begriffes
Private Function DefineRange(ByVal findMe As String) As Long
Dim rng As Range, c
With worksheet_
Set rng = .Range(.Cells(3, 1), .Cells(44, 1))
Set c = rng.Find(findMe, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then DefineRange = c.Row
End With
Set c = Nothing
Set rng = Nothing
End Function
'// Finde Wnr in Bereich
Private Function FindWNR(ByVal wnr As String, ByVal whereRow As Long, ByVal whereColumn As Long) _
As Long
Dim rng As Range, c
With worksheet_
Set rng = .Range(.Cells(whereRow, whereColumn), .Cells(whereRow + 3, whereColumn))
Set c = rng.Find(wnr, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then FindWNR = c.Row
End With
Set c = Nothing
Set rng = Nothing
End Function
'// Ändere die Zelle links neben Wnr
Private Sub ChangeOffsetCell(ByVal whereRow As Long, ByVal whereColumn As Long, ByVal amount As  _
Variant)
Dim cell_
Set cell_ = worksheet_.Cells(whereRow, whereColumn)
If cell_.Value > 0 Then
cell_.Value = cell_.Value - amount
ElseIf cell_.Value = 0 Then
cell_.ClearContents
ElseIf cell_.Value 

Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige