VBA: Zelleninhalt automatisch bei Eingabe auf mehrere Zellen aufteilen

Question

Hallo zusammen,

ich bin leider nur so mittelerfahren in VBA- Tendenz Richtung wenig :)

Ich habe eine Tabelle, in der in Spalte "B" per QR-Code ein Name mit Nummer eingescannt wird (Bsp: "Max\t100").

"\t" diente als Excape-Sequenz für den Scanner - kann auch durch jedes beliebe Trennzeichen ersetzt werden.

jetzt soll der Scan automatisch beim abscannen in Spalte "D" und "E" ausgegeben werden (gleiche Spalte)

Also Scan in B3 "Max\t100" - automatisch gesplittet in D3 "Max" und E3 "100"

kann mir da jemand helfen?

Danke schon mal

Answer 1

Hallo,

entweder so, wenn es immer nur zwei Felder sind:

Sub splitten()
Dim arrSplit As Variant

'Inhalt von Zelle B3 aufsplitten, Tennzeichen: \t
arrSplit = Split(Range("B3").Value, "\t")

'Ausgabe, Array fängt bei Null an
Range("D3") = arrSplit(0)
Range("E3") = arrSplit(1)

End Sub

oder variabel, unbekannte Anzahl von Feldern (Trennzeichen kommt mehrmals vor)

Sub splitten2()
Dim arrSplit As Variant
Dim i As Integer

'Inhalt von Zelle B3 aufsplitten, Tennzeichen: \t
arrSplit = Split(Range("B3").Value, "\t")

'Ausgabe in Zeile 3, Array enthält unbekannte Anzahl von Elemente, Ausgabe ab Spalte D
For i = LBound(arrSplit) To UBound(arrSplit)
  Cells(3, 4 + i) = arrSplit(i)
Next i

End Sub

Gruß

M.O.

Answer 2

Hallo M.O.

vielen Dank. das funktioniert prächtig. Jetzt meine (laienhafte Frage). Ich habe mehrere Tabellenblätter (mit überall der gleichen Tabelle). auf jedem Blatt soll das automatisch ablaufen. Wo füge ich den Code denn ein? Als Modul oder direkt als Code auf jedes Tabellenblatt?

Also Ziel: QR Code scannen in B, dann sofort splitten (ohne Extrabefehl).

Grüße

Answer 3

Hallo,

füge den folgenden in das VBA-Projekt jeder Tabelle deiner Arbeitsmappe ein, in der der Code gesplittet werden soll:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim arrSplit As Variant
Dim i As Integer

'Makro nur bei Eingabe in Spalte B ausführen
If Not Intersect(Target, Range("B:B")) Is Nothing Then
  'Inhalt von Zelle in Spalte B aufsplitten, Tennzeichen: \t
  arrSplit = Split(Target.Value, "\t")
  'Ausgabe in Zeile der Eingabe, Array enthält unbekannte Anzahl von Elemente, Ausgabe ab Spalte D
   For i = LBound(arrSplit) To UBound(arrSplit)
      Cells(Target.Row, 4 + i) = arrSplit(i)
   Next i
End If

End Sub

Sobald du in Spalte B eine Eingabe abgeschlossen hast, wird der QR-Code in der betreffenden Zeile zerlegt.

Gruß

M.O.

Answer 4

Hallo M.O. ein Traum. Das klappt sehr gut. Genau so wollte ich es. Mal wieder vielen Dank!!!

Ein "Problem" ist jedoch aufgetaucht. Die Liste mit den QR Codes wird am Ende des Tages wieder gelöscht. Wenn ich das mache, dann kommt immer die Fehlermeldung "Laufzeitfehler '14'" Typen unverträglich. und markiert mir die Zeile:   arrSplit = Split(Target.Value, "\t")

Woran liegt das?

Wenn du da noch ne Lösung für hast, wäre das mega.

Answer 5

Hallo,

der Fehler kommt vor, wenn z.B. eine (ganze) oder mehrere Zeilen ausgewählt werden (z.B. beim Löschen oder auch Einfügen). Dann ist Target ein Bereich und keine einzelne Zelle mehr. Damit kann Split aber nicht umgehen.

Hier das angepasste Makro:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim arrSplit As Variant
Dim i As Integer

'Wenn mehr als eine Zeile oder Spalte markiert ist, dann Makro verlassen
If Selection.Rows.Count > 1 Or Selection.Columns.Count > 1 Then Exit Sub

'Makro nur bei Eingabe in Spalte B ausführen
If Not Intersect(Target, Range("B:B")) Is Nothing Then
  'Inhalt von Zelle in Spalte B aufsplitten, Tennzeichen: \t
  arrSplit = Split(Target.Value, "\t")
  'Ausgabe in Zeile der Eingabe, Array enthält unbekannte Anzahl von Elemente, Ausgabe ab Spalte D
   For i = LBound(arrSplit) To UBound(arrSplit)
      Cells(Target.Row, 4 + i) = arrSplit(i)
   Next i
End If

End Sub

Gruß

M.O.

Answer 6

Nochmal Hallo,

auch mit dem neuen Makro kommt der Fehler bei der selben Stelle. Zwar keine Meldung mit dem Laufzeitfehler, aber die selbe Zeile wird gelb markiert (arrSplit = Split(Target.Value, "\t"))

Zum löschen nutze ich eine Schaltfläche mit folgendem Makro:

Sheets("Zentrale2").Range("B3:B30").ClearContents
Sheets("Zentrale2").Range("D3:G30").ClearContents

Spalte "C" soll nicht gelöscht werden.

soll ich mal eine Beispieldatei hochladen? HIlft das was?

Answer 7

Hallo,

beim Löschen durch ein Makro funktioniert meine Modifikation natürlich nicht.

Ändere dein Löschen-Makro wie folgt:

Sub löschen()
'Ereignissteuerungen ausschalten
 Application.EnableEvents = False

Sheets("Zentrale2").Range("B3:B30").ClearContents
Sheets("Zentrale2").Range("D3:G30").ClearContents

'Ereignissteuerungen einschalten
Application.EnableEvents = True
End Sub

Damit wird beim Ausführen des Löschen-Makros das automatisierte Makro nicht ausgeführt.

Gruß

M.O.