Supportnet / Forum / Tabellenkalkulation
Autom. Datenübernahme
Frage
Hallo !! Ich habe in einer Tabelle 2 Tabellenblätter. Im ersten Blatt ist eine Liste mit Namen und zugehörigen Kundennummern. Im zweiten Blatt eine Liste in welcher Anträge aufgenommen werden. Nun möchte ich, daß wenn ich in Tabelle 2 einen Namen + KDnummer eingebe die Liste auf Blatt 1 automatisch aktualisiert wird, falls der Name dort noch nicht bekannt ist. Falls der Name schon bekannt sein sollte, soll bei Eingabe des Namens auf Blatt 2 automatisch die Kundennummer eingesetzt werden. Für Hilfe wäre ich dankbar.
[*][quote][sup][i]Admininfo: bitte vermeide Mehrfachanfragen in verschiedenen, bzw. gleichen Gruppen. Siehe [url=https://supportnet.de/groupfaqs/3][u]FAQ 2.[/u][/url][/i][/sup][/quote]
Antwort 1 von MariellaZ
Kann mir keiner einen Anstoss geben wie ich meine Wünsche erfüllen kann ? :o(
Ich hab leider in der Hilfe keine Lösung finden können.
Ich hab leider in der Hilfe keine Lösung finden können.
Antwort 2 von Saarbauer
Hallo,
ist aus meiner Sicht nur mit VBA machbar
Gruß
Helmut
ist aus meiner Sicht nur mit VBA machbar
Gruß
Helmut
Antwort 3 von MariellaZ
Hi Saarbauer !
Hast Du auch eine Ahnung wie in VBA ?
Ich nämlich leider nicht :ó(
Hast Du auch eine Ahnung wie in VBA ?
Ich nämlich leider nicht :ó(
Antwort 4 von rolandaa
voraussetzung,
tabelle1 name =A1, nummer =B1 zähler =C1
tabelle2 name in spalte A nummer in spalte B
folgendes makro:
Sub nametest()
Dim name As String
Dim nummer As Integer
Dim max As Integer
Sheets("Tabelle1").Select
Range("C1").Activate
ActiveCell.FormulaR1C1 = "=MAXA(Tabelle2!C[-1])"
name = Range("A1").Value
nummer = Range("B1").Value
max = Range("C1").Value
Sheets("Tabelle2").Select
Range("A1").Activate
While ActiveCell <> name
If ActiveCell = "" Then
nummer = InputBox("Bitte neue Kundennummer eingeben", "neuer Kunde", max + 1)
ActiveCell = name
ActiveCell.Offset(0, 1).Activate
ActiveCell = nummer
Sheets("Tabelle1").Select
Range("B1").Value = nummer
Exit Sub
End If
ActiveCell.Offset(1, 0).Activate
Wend
nummer = ActiveCell.Offset(0, 1).Value
Sheets("Tabelle1").Select
Range("B1").Value = nummer
End Sub
mfg
roland
tabelle1 name =A1, nummer =B1 zähler =C1
tabelle2 name in spalte A nummer in spalte B
folgendes makro:
Sub nametest()
Dim name As String
Dim nummer As Integer
Dim max As Integer
Sheets("Tabelle1").Select
Range("C1").Activate
ActiveCell.FormulaR1C1 = "=MAXA(Tabelle2!C[-1])"
name = Range("A1").Value
nummer = Range("B1").Value
max = Range("C1").Value
Sheets("Tabelle2").Select
Range("A1").Activate
While ActiveCell <> name
If ActiveCell = "" Then
nummer = InputBox("Bitte neue Kundennummer eingeben", "neuer Kunde", max + 1)
ActiveCell = name
ActiveCell.Offset(0, 1).Activate
ActiveCell = nummer
Sheets("Tabelle1").Select
Range("B1").Value = nummer
Exit Sub
End If
ActiveCell.Offset(1, 0).Activate
Wend
nummer = ActiveCell.Offset(0, 1).Value
Sheets("Tabelle1").Select
Range("B1").Value = nummer
End Sub
mfg
roland
Antwort 5 von MariellaZ
Hallo Rolandaa !
Danke erstmal für die Hilfe,
der Zähler funktioniert schonmal wunderbar, ebenfalls die Funtkion in der ersten Zeile, wobei ich allerdings immer eine neue Kundennummer vergeben muß, selbst wenn im Feld B schon eine steht. Und leider klappt die Übernahme nur in der ersten Zeile.
Deine Hilfe war aber schon sehr wertvoll. Danke
Danke erstmal für die Hilfe,
der Zähler funktioniert schonmal wunderbar, ebenfalls die Funtkion in der ersten Zeile, wobei ich allerdings immer eine neue Kundennummer vergeben muß, selbst wenn im Feld B schon eine steht. Und leider klappt die Übernahme nur in der ersten Zeile.
Deine Hilfe war aber schon sehr wertvoll. Danke
Antwort 6 von nighty
hi all :)
kleines beispiel :))
gruss nighty
eingabezellen wie folgt
Sheet2/A2=Name
sheet2/B2=Nummer
Sheet1/SpalteA=Namen
Sheet1/SpalteB=Nummer
einzufuegen alt+f11/projektexplorer/sheet2
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim suche As Range
Set suche = Sheets(1).Range("A" & (1) & ":A" & _
Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Find(Sheets(2).Cells(2, 1), LookIn:=xlValues)
If Not suche Is Nothing Then
Sheets(2).Cells(2, 2) = Sheets(1).Cells(suche.Row, 2)
Else
If Sheets(2).Cells(2, 1) <> "" And Sheets(2).Cells(2, 2) <> "" Then
Sheets(2).Range("A2:B2").Copy _
Sheets(1).Range("A" & Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
End If
End If
End Sub
kleines beispiel :))
gruss nighty
eingabezellen wie folgt
Sheet2/A2=Name
sheet2/B2=Nummer
Sheet1/SpalteA=Namen
Sheet1/SpalteB=Nummer
einzufuegen alt+f11/projektexplorer/sheet2
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim suche As Range
Set suche = Sheets(1).Range("A" & (1) & ":A" & _
Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Find(Sheets(2).Cells(2, 1), LookIn:=xlValues)
If Not suche Is Nothing Then
Sheets(2).Cells(2, 2) = Sheets(1).Cells(suche.Row, 2)
Else
If Sheets(2).Cells(2, 1) <> "" And Sheets(2).Cells(2, 2) <> "" Then
Sheets(2).Range("A2:B2").Copy _
Sheets(1).Range("A" & Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
End If
End If
End Sub
Antwort 7 von nighty
hi all :)
ich vergass noch etwas :))
gruss nighty
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
Dim suche As Range
Set suche = Sheets(1).Range("A" & (1) & ":A" & _
Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Find(Sheets(2).Cells(2, 1), LookIn:=xlValues)
If Not suche Is Nothing Then
Sheets(2).Cells(2, 2) = Sheets(1).Cells(suche.Row, 2)
Else
If Sheets(2).Cells(2, 1) <> "" And Sheets(2).Cells(2, 2) <> "" Then
Sheets(2).Range("A2:B2").Copy _
Sheets(1).Range("A" & Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
End If
End If
Application.EnableEvents = True
End Sub
ich vergass noch etwas :))
gruss nighty
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
Dim suche As Range
Set suche = Sheets(1).Range("A" & (1) & ":A" & _
Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Find(Sheets(2).Cells(2, 1), LookIn:=xlValues)
If Not suche Is Nothing Then
Sheets(2).Cells(2, 2) = Sheets(1).Cells(suche.Row, 2)
Else
If Sheets(2).Cells(2, 1) <> "" And Sheets(2).Cells(2, 2) <> "" Then
Sheets(2).Range("A2:B2").Copy _
Sheets(1).Range("A" & Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
End If
End If
Application.EnableEvents = True
End Sub
Antwort 8 von nighty
hi all :))
noch ein wenig verbessert :)
gruss nighty
sollte der name nicht vorhanden sein wird automatisch die nächst höhere nummer vergeben von den vorhandenen ausgehend
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
Dim suche As Range
Set suche = Sheets(1).Range("A" & (1) & ":A" & _
Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Find(Sheets(2).Cells(2, 1), LookIn:=xlValues)
If Not suche Is Nothing Then
Sheets(2).Cells(2, 2) = Sheets(1).Cells(suche.Row, 2)
Else
If Sheets(2).Cells(2, 1) <> "" Then
Sheets(2).Range("B2") = Application.WorksheetFunction.Max(Sheets(1).Range("B" & (1) & ":B" & _
Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row)) + 1
Sheets(2).Range("A2:B2").Copy _
Sheets(1).Range("A" & Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
End If
End If
Application.EnableEvents = True
End Sub
noch ein wenig verbessert :)
gruss nighty
sollte der name nicht vorhanden sein wird automatisch die nächst höhere nummer vergeben von den vorhandenen ausgehend
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
Dim suche As Range
Set suche = Sheets(1).Range("A" & (1) & ":A" & _
Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Find(Sheets(2).Cells(2, 1), LookIn:=xlValues)
If Not suche Is Nothing Then
Sheets(2).Cells(2, 2) = Sheets(1).Cells(suche.Row, 2)
Else
If Sheets(2).Cells(2, 1) <> "" Then
Sheets(2).Range("B2") = Application.WorksheetFunction.Max(Sheets(1).Range("B" & (1) & ":B" & _
Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row)) + 1
Sheets(2).Range("A2:B2").Copy _
Sheets(1).Range("A" & Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
End If
End If
Application.EnableEvents = True
End Sub
Antwort 9 von MariellaZ
Danke schön Nighty !!
Antwort 7 ist genau das was ich suchte.
:o) und es ist sogar einigermaßen nachvollziehbar :o)
Ich habe versucht nun noch einzubauen, daß immer die aktuelle Zelle in Spalte A (Kunde) und Spalte B (Nummer) abgefragt wird, damit ich nicht auf die Zeile 2 angewiesen bin zur Eingabe.
Hab ich aber leider bisher nicht hingekriegt, ohne daß alles nochmal abgefragt wird. Wenn Ihr noch ein wenig Geduld habt wäre ein letzer Lösungsansatz sehr nett.
mfg Mariella
Antwort 7 ist genau das was ich suchte.
:o) und es ist sogar einigermaßen nachvollziehbar :o)
Ich habe versucht nun noch einzubauen, daß immer die aktuelle Zelle in Spalte A (Kunde) und Spalte B (Nummer) abgefragt wird, damit ich nicht auf die Zeile 2 angewiesen bin zur Eingabe.
Hab ich aber leider bisher nicht hingekriegt, ohne daß alles nochmal abgefragt wird. Wenn Ihr noch ein wenig Geduld habt wäre ein letzer Lösungsansatz sehr nett.
mfg Mariella
Antwort 10 von nighty
hi Mariella :))
eingabefelder sind nun sheet2/spalte a +b
suchbegrif arbeitet in wechselwirkung
zahl gefunden=name ergänzt
oder
name gefunden=zahl ergänzt
wobei zahlen in spalte b wie namen in spalte des 2 sheets eingegeben werden muessen
so vielleicht besser :))
gruss nighty
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim suche As Range
Set suche = Sheets(1).Range("A" & (1) & ":B" & _
Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Find(Sheets(2).Cells(Target.Row, Target.Column), LookIn:=xlValues)
If Not suche Is Nothing Then
If suche.Column = 1 Then Sheets(2).Cells(Target.Row, 2) = Sheets(1).Cells(suche.Row, 2)
If suche.Column = 2 Then Sheets(2).Cells(Target.Row, 1) = Sheets(1).Cells(suche.Row, 1)
Else
If Sheets(2).Cells(Target.Row, 1) <> "" And Sheets(2).Cells(Target.Row, 2) <> "" Then
Sheets(2).Range("A" & Target.Row & ":B" & Target.Row).Copy _
Sheets(1).Range("A" & Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
End If
End If
Application.EnableEvents = True
End Sub
eingabefelder sind nun sheet2/spalte a +b
suchbegrif arbeitet in wechselwirkung
zahl gefunden=name ergänzt
oder
name gefunden=zahl ergänzt
wobei zahlen in spalte b wie namen in spalte des 2 sheets eingegeben werden muessen
so vielleicht besser :))
gruss nighty
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim suche As Range
Set suche = Sheets(1).Range("A" & (1) & ":B" & _
Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Find(Sheets(2).Cells(Target.Row, Target.Column), LookIn:=xlValues)
If Not suche Is Nothing Then
If suche.Column = 1 Then Sheets(2).Cells(Target.Row, 2) = Sheets(1).Cells(suche.Row, 2)
If suche.Column = 2 Then Sheets(2).Cells(Target.Row, 1) = Sheets(1).Cells(suche.Row, 1)
Else
If Sheets(2).Cells(Target.Row, 1) <> "" And Sheets(2).Cells(Target.Row, 2) <> "" Then
Sheets(2).Range("A" & Target.Row & ":B" & Target.Row).Copy _
Sheets(1).Range("A" & Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
End If
End If
Application.EnableEvents = True
End Sub
Antwort 11 von MariellaZ
Hervoragend :o)
Danke Nighty !
Ihr seid (Du bist) toll :o)
Danke Nighty !
Ihr seid (Du bist) toll :o)

