HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Problem mit dem richtigen einfügen von Daten

Problem mit dem richtigen einfügen von Daten
25.09.2003 12:53:53
T.Reingruber
Hallo Leute.

Ich habe folgendes Problem: Ich will, dass eine Tabelle "GDT" mit einem Wert aus Arbeitsblatt "NDE" verglichen wird. Ist dieser Wert schon in "GDT" enthalten, soll der Vorgang abgebrochen werden, was ja auch kein Problem darstellt. Ist der Wert aber nicht vorhanden, sollen der Vergleichswert und andere Werte, die sich auf dem gleichen Blatt befinden (z.B. C9 & C13) in die erste leere Zeile von tabelle GDT eingefügt werden. Ich habe folgenden VBA - Code erarbeitet, aber es funktioniert nicht. Es werden entweder keine Daten übertragen, oder, ist der Wert vorhanden, wird er ein weiteres Mal eingetragen (Was nie vorkommen darf!!) Weiß jemand, wie das Problem zu lösen ist?!
Dankeschön im Voraus.


Private Sub einfügen_Click()
If Worksheets("NDE").Range("C9") = "" Or Worksheets("NDE").Range("C13") = "" Then
MsgBox ("Es fehlen Eingaben!!")
Range("C9").Select
Else
'ab hier beginnt das "Problem" '
Dim c As Range
Dim Sb As String
Dim laR As Long, i As Long
Dim Rg As Byte
Application.ScreenUpdating = False
Sb = Sheets("NDE").Range("C13").Value
laR = Sheets("GDT").Cells(Rows.Count, 1).End(xlUp).Row
For Each c In Sheets("GDT").Range("A1:A" & laR)
If c.Value = Sb Then
MsgBox ("Wert existiert schon")
'Bis hierher ist ja alles klar, aber ...'
Else
MsgBox ("Daten werden eingefügt")
'Sollte der Wert nicht existieren, dann muß die Eingabe aus WS NDE in WS GDT eingefügt werden'
Dim Zeile
Zeile = Worksheets("GDT").Range("A1").End(xlDown).Row + 1
Worksheets("NDE").Range("C9").Copy _
Worksheets("GDT").Cells(Zeile, 9)
Exit For
End If
Next c
Application.ScreenUpdating = True
End If
End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Benutzer
AW: Problem mit dem richtigen einfügen von Daten
25.09.2003 13:09:01
xXx
Hallo,
ist doch klar!
If c.Value = Sb Then
MsgBox ("Wert existiert schon")
'Bis hierher ist ja alles klar, aber ...'
Else
MsgBox ("Daten werden eingefügt")
'Sollte der Wert nicht existieren, dann muß die Eingabe aus WS NDE in WS GDT eingefügt werden'
Dim Zeile
Das trifft immer ein, wenn die Werte nicht gleich sind, auch wenn der Wert später vorkommt!!!
Besser, du suchst dein sb in der Spalte mit der Find-Methode, anstatt alle Zellen abzuklappern. Geht auch erheblich schneller.

With Sheets("GDT").Range("A1:A" & laR)
Set c = .Find(sb, lookin:=xlValues)
If Not c Is Nothing Then
'hier dein Code
End If
End With

Gruß aus'm Pott
Udo
AW: Problem mit dem richtigen einfügen von Daten
26.09.2003 10:39:33
T.Reingruber
Hallo Leuts.

Danke für eure Vorschläge. Ich werds gleich mal einbauen und schauen, obs funktioniert.
AW: Problem mit dem richtigen einfügen von Daten
25.09.2003 13:13:42
ChrisL
Hi T.

Option Explicit


Private Sub einfügen_Click()
Dim c As Range
Dim Sb As String
Dim laR As Long
Dim Rg As Byte
Application.ScreenUpdating = False
If Worksheets("NDE").Range("C9") = "" Or Worksheets("NDE").Range("C13") = "" Then
MsgBox ("Es fehlen Eingaben!!")
Range("C9").Select
Else
Sb = Sheets("NDE").Range("C13").Value
laR = Sheets("GDT").Cells(Rows.Count, 1).End(xlUp).Row
For Each c In Sheets("GDT").Range("A1:A" & laR)
If c.Value = Sb Then
MsgBox ("Wert existiert schon")
Exit Sub
End If
Next c
MsgBox ("Daten werden eingefügt")
Worksheets("NDE").Range("C9").Copy _
Worksheets("GDT").Cells(laR + 1, 9)
End If
Application.ScreenUpdating = True
End Sub


Oder m.E. eleganter...

Option Explicit


Private Sub einfügen_Click()
Dim c As Range
Dim Sb As String
Dim laR As Long
Dim Rg As Byte
Application.ScreenUpdating = False
If Worksheets("NDE").Range("C9") = "" Or Worksheets("NDE").Range("C13") = "" Then
MsgBox ("Es fehlen Eingaben!!")
Range("C9").Select
Else
Sb = Sheets("NDE").Range("C13").Value
laR = Sheets("GDT").Cells(Rows.Count, 1).End(xlUp).Row
If Application.WorksheetFunction.CountIf(Sheets("GDT").Range("A1:A" & laR), Sb) > 0 Then
MsgBox ("Wert existiert schon")
Exit Sub
End If
MsgBox ("Daten werden eingefügt")
Worksheets("NDE").Range("C9").Copy _
Worksheets("GDT").Cells(laR + 1, 9)
End If
Application.ScreenUpdating = True
End Sub



Gruss
Chris

Meistgelesene Forumthreads (12 Monate)

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