Supportnet Computer
Planet of Tech

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.

Antwort 2 von Saarbauer

Hallo,

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 :ó(

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

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

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

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

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

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 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

Antwort 11 von MariellaZ

Hervoragend :o)
Danke Nighty !
Ihr seid (Du bist) toll :o)

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: