Live-Forum - Die aktuellen Beiträge
Datum
Titel
05.05.2024 14:57:43
Bei Dropdown-Auswahl Zellen kopieren und verschieben
05.05.2024 14:16:11
Anzahl Tage im Jahr bei Zelle von bis mit mehreren Jahren
05.05.2024 12:26:30
Stunden addieren
05.05.2024 11:49:03
Bedingte Formatierung, Auslesen der Adresse aus einer Zelle
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1892to1896
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1892to1896
1892to1896
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

For Schleife

For Schleife
17.08.2022 13:54:05
Herbert
Guten Tag meine Freunde der Sonne,
ist es möglich Ergebnisse aus einer For Schleife in einer Zelle zu verketten,
die Werte werden sonst vorher nach einander ausgegeben.
Code:

Private Sub cmdbtn_ÜBERNAHME_Click()
Dim i As Integer, k As Integer, e As Integer, _
Vari As Variant, x As Integer, APWF As WorksheetFunction, _
o As Integer
Set APWF = Application.WorksheetFunction
For i = 1 To Worksheets("Datenbank").Range("tbl_Lieferschein").Rows.Count
If Worksheets("Datenbank").Range("tbl_Lieferschein").Cells(i, 1).Value = "" Then
'DEHA-Gehänge in Tabelle übernehmen:
Worksheets("Datenbank").Range("tbl_Lieferschein").Cells(i, 1).Value = Range("Lieferschein_Nummer").Value
For e = 20 To 25
Vari = Worksheets("Datenbank").Cells(1, e)
For x = 3 To 7
On Error GoTo Fehlerbehebung:
If Vari = "1-1,3 to." Then
Worksheets("Datenbank").Range("tbl_Lieferschein").Cells(i, 7).Value = APWF.VLookup(Vari, Range("tbl_Inventarnummern"), x, False)
ElseIf Vari = "1,5-2,5 to." Then
Worksheets("Datenbank").Range("tbl_Lieferschein").Cells(i, 8).Value = Application.WorksheetFunction.VLookup(Vari, Range("tbl_Inventarnummern"), x, False)
ElseIf Vari = "3-5 to." Then
Worksheets("Datenbank").Range("tbl_Lieferschein").Cells(i, 9).Value = Application.WorksheetFunction.VLookup(Vari, Range("tbl_Inventarnummern"), x, False)
ElseIf Vari = "6-10 to." Then
Worksheets("Datenbank").Range("tbl_Lieferschein").Cells(i, 10).Value = Application.WorksheetFunction.VLookup(Vari, Range("tbl_Inventarnummern"), x, False)
ElseIf Vari = "12-20 to." Then
Worksheets("Datenbank").Range("tbl_Lieferschein").Cells(i, 11).Value = Application.WorksheetFunction.VLookup(Vari, Range("tbl_Inventarnummern"), x, False)
Else
Worksheets("Datenbank").Range("tbl_Lieferschein").Cells(i, 12).Value = Application.WorksheetFunction.VLookup(Vari, Range("tbl_Inventarnummern"), x, False)
End If
Next x
Fehlerbehebung:
Resume Next
Next e
'Andere Daten vom Lieferschein übernehmen:
Worksheets("Datenbank").Range("tbl_Lieferschein").Cells(i, 2).Value = Range("Name_Verlader").Value
Worksheets("Datenbank").Range("tbl_Lieferschein").Cells(i, 3).Value = Range("Auftragsnummer").Value
Worksheets("Datenbank").Range("tbl_Lieferschein").Cells(i, 4).Value = Range("Kunde").Value
Worksheets("Datenbank").Range("tbl_Lieferschein").Cells(i, 5).Value = Range("Baustelle").Value
Worksheets("Datenbank").Range("tbl_Lieferschein").Cells(i, 6).Value = Range("Datum").Value
Worksheets("Datenbank").Range("tbl_Lieferschein").Cells(i, 15).Value = Range("Spedition").Value
Worksheets("Datenbank").Range("tbl_Lieferschein").Cells(i, 16).Value = Range("Fahrzeug_Kennzeichen").Value
Worksheets("Datenbank").Range("tbl_Lieferschein").Cells(i, 17).Value = Range("Fahrer").Value
Worksheets("Datenbank").Range("tbl_Lieferschein").Cells(i, 18).Value = Range("Unterschrift").Value
Worksheets("Datenbank").Range("tbl_Lieferschein").Cells(i, 19).Value = Range("Blockschrift").Value
Worksheets("Datenbank").Range("tbl_Lieferschein").Cells(i, 20).Value = Range("Auf_Baustelle_verblieben").Value
Exit Sub
End If
Next i
End Sub
Erstes Ergebnis: APWF.VLookup(Vari, Range("tbl_Inventarnummern"), x, False)
(APWF steht für Application.WorksheetsFunction)
Bei den Ergebnissen werden immer mehrere ausgegeben,
das ist auch so gewollt,
er spuckt mir die Ergebnisse in einer aus einer For-Schleife aus,
wo er dann z.B.: "1234; 1235 ; 1236; 1237" hat.
Die Werte wären zu allererst alle alleine in einer Zelle in einer Tabelle.
Spalte 3 - 7 (1 = Laststufe, 2 = Menge), diese möchte ich aber nicht als feste Range angeben, weil es variabel zu neuen Touren sein soll.
Es kann sein das in einer Tour 20 Inventarnummern sind mit á 5 verschiedenen Laststufen (wovon dann 4 jeweils zu einer Laststufe zählen.)
Die Tabellenüberschriften der Inventarnummern lauten "1.:" - "4.:", also immer gleich die Anführungszeichen weg und dann von 1 - 4.
Als Ergebnis möchte ich die Zahlen wie oben in einer Zelle stehen haben...,
ich selber schaffe es aber nicht die Daten direkt in der Schleife zu verknüpfen/verketten,
bin mir aber auch nicht sicher ob dies überhaupt möglich ist.
MfG
Herbert

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
For Schleife (Werte verketten)
17.08.2022 14:15:58
Herbert
Moin moin,
hier einmal meine Möglichkeit wie ich es hinbekommen habe,
was zu 100% keine schlaue/schöne Lösung ist.
Code (von On Error -> Abfrage zweite Laststufe:

On Error GoTo Fehlerbehebung:
If Vari = "1-1,3 to." Then
Ergebnis4 = Ergebnis3
Ergebnis3 = Ergebnis2
Ergebnis2 = Ergebnis1
Ergebnis1 = APWF.VLookup(Vari, Range("tbl_Inventarnummern"), x, False)
MsgBox Ergebnis4 & Ergebnis3 & Ergebnis2 & Ergebnis1
ElseIf Vari = "1,5-2,5 to." Then
Hier liste ich so jetzt 4 Ergebnisvariablen auf,
womit ich die Ergebnisse dann im Endeffekt verkettet hab.
MfG
Herbert
Anzeige
AW: For Schleife (Werte verketten)
17.08.2022 15:33:54
guenni
Grundsätzlich scheint es mir um die Einführung einer String-Variablen zu gehen:

Dim Ausgabetext as String
dim i
Ausgabetext = "Hier kommen die Zahlen: "
For i = 1230 to 1234
Ausgabetext=Ausgabetext & i & "; "
next
msgbox Ausgabetext

AW: For Schleife
17.08.2022 15:39:25
Rudi
Hallo,
ganz klar ist mir nicht, was das soll.
teste mal

Private Sub cmdbtn_ÜBERNAHME_Click()
Dim i As Integer, k As Integer, e As Integer, _
Vari As Variant, x As Integer, APWF As WorksheetFunction, _
o As Integer
Dim rngLS As Range, lCol As Long
Dim strERG As String, vntERG As Variant
Set rngLS = Worksheets("Datenbank").Range("tbl_Lieferschein")
Set APWF = Application.WorksheetFunction
For i = 1 To rngLS.Rows.Count
If rngLS.Cells(i, 1).Value = "" Then
'DEHA-Gehänge in Tabelle übernehmen:
rngLS.Cells(i, 1).Value = Range("Lieferschein_Nummer").Value
For e = 20 To 25
strERG = vbNullString
Vari = Worksheets("Datenbank").Cells(1, e)
For x = 3 To 7
Select Case Vari
Case "1-1,3 to.":        lCol = 7
Case "1,5-2,5 to.":      lCol = 8
Case "3-5 to.":          lCol = 9
Case "6-10 to.":         lCol = 10
Case "12-20 to.":        lCol = 11
Case Else:               lCol = 12
End Select
vntERG = Application.VLookup(Vari, rngLS, x, False)
If Not IsError(vntERG) Then
strERG = strERG & " " & vntERG
rngLS.Cells(i, lCol).Value = vntERG
End If
Next x
MsgBox strERG
Next e
'Andere Daten vom Lieferschein übernehmen:
rngLS.Cells(i, 2).Value = Range("Name_Verlader").Value
rngLS.Cells(i, 3).Value = Range("Auftragsnummer").Value
rngLS.Cells(i, 4).Value = Range("Kunde").Value
rngLS.Cells(i, 5).Value = Range("Baustelle").Value
rngLS.Cells(i, 6).Value = Range("Datum").Value
rngLS.Cells(i, 15).Value = Range("Spedition").Value
rngLS.Cells(i, 16).Value = Range("Fahrzeug_Kennzeichen").Value
rngLS.Cells(i, 17).Value = Range("Fahrer").Value
rngLS.Cells(i, 18).Value = Range("Unterschrift").Value
rngLS.Cells(i, 19).Value = Range("Blockschrift").Value
rngLS.Cells(i, 20).Value = Range("Auf_Baustelle_verblieben").Value
Exit Sub
End If
Next i
End Sub
Gruß
Rudi
Anzeige
Perfekt, danke vielmals!
17.08.2022 16:27:28
Herbert
Hallo Rudi,
danke schon einmal für dein Code,
hat erst nicht funktioniert,
ein zwei Sachen musste ich abändern,
funktioniert jetzt aber perfekt! :)
Danke vielmals!
Mein Code jetzt:

Private Sub cmdbtn_ÜBERNAHME_Click()
Dim i As Integer, k As Integer, e As Integer, _
Vari As Variant, x As Integer, APWF As WorksheetFunction, _
o As Integer
Dim rngLS As Range, rngIN As Range, lCol As Long
Dim strERG As String, vntERG As Variant
Set rngLS = Worksheets("Datenbank").Range("tbl_Lieferschein")
Set rngIN = Worksheets("Lieferschein Daten übernahme").Range("tbl_Inventarnummern")
Set APWF = Application.WorksheetFunction
For i = 1 To rngLS.Rows.Count
If rngLS.Cells(i, 1).Value = "" Then
'DEHA-Gehänge in Tabelle übernehmen:
rngLS.Cells(i, 1).Value = Range("Lieferschein_Nummer").Value
For e = 20 To 25
strERG = vbNullString
Vari = Worksheets("Datenbank").Cells(1, e)
For x = 3 To 7
Select Case Vari
Case "1-1,3 to.":        lCol = 7
Case "1,5-2,5 to.":      lCol = 8
Case "3-5 to.":          lCol = 9
Case "6-10 to.":         lCol = 10
Case "12-20 to.":        lCol = 11
Case Else:               lCol = 12
End Select
vntERG = Application.VLookup(Vari, rngIN, x, False)
If Not IsError(vntERG) Then
strERG = strERG & "; " & vntERG
rngLS.Cells(i, lCol).Value = Mid(strERG, 2)
End If
Next x
Next e
'Andere Daten vom Lieferschein übernehmen:
rngLS.Cells(i, 2).Value = Range("Name_Verlader").Value
rngLS.Cells(i, 3).Value = Range("Auftragsnummer").Value
rngLS.Cells(i, 4).Value = Range("Kunde").Value
rngLS.Cells(i, 5).Value = Range("Baustelle").Value
rngLS.Cells(i, 6).Value = Range("Datum").Value
rngLS.Cells(i, 15).Value = Range("Spedition").Value
rngLS.Cells(i, 16).Value = Range("Fahrzeug_Kennzeichen").Value
rngLS.Cells(i, 17).Value = Range("Fahrer").Value
rngLS.Cells(i, 18).Value = Range("Unterschrift").Value
rngLS.Cells(i, 19).Value = Range("Blockschrift").Value
rngLS.Cells(i, 20).Value = Range("Auf_Baustelle_verblieben").Value
Exit Sub
End If
Next i
End Sub
MfG
Herbert
Anzeige
Bei leer Zellen keine weiteren Trennzeichen
17.08.2022 17:02:55
Herbert
Moin Rudi und auch die anderen die Helfen wollen und können,
gibt es noch eine Möglichkeit den Wert vntERG auf den Inhalt zu überprüfen und wenn dieser Leer ist keine weiteren Trennzeichen auszugeben,
heißt wenn mal zwei Inventarnummern da stehen und keine 4, dass das Ergebnis nicht "1234; 1235; ;" ist?
Code Bereich:

vntERG = Application.VLookup(Vari, rngIN, x, False)
If Not IsError(vntERG) Then
strERG = strERG & "; " & vntERG
rngLS.Cells(i, lCol).Value = Mid(strERG, 2)
End If
Next x
Next e
Danke für jeden der Hilft!
MfG
Herbert
Anzeige
AW: Bei leer Zellen keine weiteren Trennzeichen
17.08.2022 22:20:24
Rudi 

          vntERG = Application.VLookup(Vari, rngIN, x, False)
If Not IsError(vntERG) Then
If vntERGvbNullstring Then
strERG = strERG & "; " & vntERG
rngLS.Cells(i, lCol).Value = Mid(strERG, 2)
End If
End If
Next x
Next e
oder If vntERG "" Then
oder If Len(vntERG) Then
Gruß
Rudi
AW: Bei leer Zellen keine weiteren Trennzeichen
18.08.2022 08:35:01
Herbert
Guten Morgen Rudi,
danke vielmals und wieder viel dazu gelernt!
Funktioniert einwandfrei,
jetzt nur noch ein wenig fein Schliff und perfekt!
MfG
Herbert
Doppelte Laststufen
18.08.2022 10:21:32
Herbert
Guten Morgen ich nochmal,
kann ich auch wenn darunter Beispielsweise noch einmal die Laststufe "1-1,3 to." kommt,
diese auch mit den anderen aus der selben Laststufe verketten?
Mein Derzeitiger Code bei der Verkettung und den Inventarnummern ist das hier:

  For i = 1 To rngLS.Rows.Count
If rngLS.Cells(i, 1).Value = "" Then
'DEHA-Gehänge in Tabelle übernehmen:
rngLS.Cells(i, 1).Value = Range("Lieferschein_Nummer").Value
For e = 20 To 25
strERG = vbNullString
Vari = Worksheets("Datenbank").Cells(1, e)
For x = 3 To 7
Select Case Vari
Case "1-1,3 to.":        lCol = 7
Case "1,5-2,5 to.":      lCol = 8
Case "3-5 to.":          lCol = 9
Case "6-10 to.":         lCol = 10
Case "12-20 to.":        lCol = 11
Case Else:               lCol = 12
End Select
vntERG = Application.VLookup(Vari, rngIN, x, False)
If Not IsError(vntERG) Then
If vntERG  vbNullString Then
strERG = strERG & "; " & vntERG
rngLS.Cells(i, lCol).Value = Mid(strERG, 2)
End If
End If
Next x
Next e
Zeile A15 steht "1-1,3 to." und in Zeile A17 wieder,
jetzt habe ich in beiden Fällen die selbe Laststufe,
aber die einen Inventarnummern würden einfach ignoriert werden.
Diese sollen aber mit in die selbe Zelle wie die anderen,
sodass es Einheitlich ist.
MfG
Herbert
Anzeige
lade doch mal die Datei hoch. owT
18.08.2022 11:32:06
Rudi
Datei
18.08.2022 12:58:36
Herbert
Moin Rudi,
anbei die Datei in der das ganze passieren soll.
In der Datei habe ich in Rot auch noch hingeschrieben was passieren soll.
Beispieldatei:
https://www.herber.de/bbs/user/154708.xlsm
MfG
Herbert
AW: Datei
18.08.2022 16:12:47
Rudi 

      For e = 20 To 25
strERG = vbNullString
Vari = Worksheets("Datenbank").Cells(1, e)
Select Case Vari
Case "1-1,3 to.":        lCol = 7
Case "1,5-2,5 to.":      lCol = 8
Case "3-5 to.":          lCol = 9
Case "6-10 to.":         lCol = 10
Case "12-20 to.":        lCol = 11
Case Else:               lCol = 12
End Select
For Each rngC In rngIN.Columns(1).Cells
If rngC = Vari Then
For x = 2 To 5
If rngC.Offset(, x)  "" Then
strERG = strERG & "; " & rngC.Offset(, x)
End If
Next x
If Len(strERG) Then rngLS.Cells(i, lCol).Value = Mid(strERG, 2)
End If
Next rngC
Next e
Gruß
Rudi
Anzeige
AW: Datei
19.08.2022 08:28:19
Herbert
Guten Morgen Rudi,
danke ersteinmal für deine Antwort,
aber als was hast du rngC Definiert und (wahrscheinlich als Range wegen der Abkürzung),
aber welche Tabelle sitzt als Verbindung hinter dieser Variablen Range.
Wenn ich diese Punkte noch habe,
kann ich den Code anwenden. :)
MfG
Herbert
AW: Datei
19.08.2022 08:46:12
Rudi
Hallo,
rngC ist ein Range und durchläuft die Spalte 1 deines rngIN, also Worksheets("Lieferschein Daten übernahme").Range("tbl_Inventarnummern")
For Each rngC In rngIN.Columns(1).Cells
Du muss nur in deinen Code
For e=.... Next e durch meinen Schnipsel ersetzen und am Anfang Dim rngC As Range einfügen
Gruß
Rudi
Anzeige
Ah doch Perfekt! :D
19.08.2022 10:03:05
Herbert
Moin Rudi,
jau hat jetzt geklappt,
ich hatte die Tabelle noch einmal von der Position her verändert,
weshalb das Auslesen von einem Wert nicht funktioniert hat... .
Ich danke dir vielmals Rudi!
MfG
Herbert

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige