Herbers Excel-Forum - das Archiv

Problem mit dem richtigen einfügen von Daten

Bild

Betrifft: Problem mit dem richtigen einfügen von Daten
von: T.Reingruber
Geschrieben am: 25.09.2003 12:53:53
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

Bild

Betrifft: AW: Problem mit dem richtigen einfügen von Daten
von: xXx
Geschrieben am: 25.09.2003 13:09:01
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
Bild

Betrifft: AW: Problem mit dem richtigen einfügen von Daten
von: T.Reingruber
Geschrieben am: 26.09.2003 10:39:33
Hallo Leuts.

Danke für eure Vorschläge. Ich werds gleich mal einbauen und schauen, obs funktioniert.
Bild

Betrifft: AW: Problem mit dem richtigen einfügen von Daten
von: ChrisL
Geschrieben am: 25.09.2003 13:13:42
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
 Bild
Excel-Beispiele zum Thema " Problem mit dem richtigen einfügen von Daten"
Verschnittproblem mit Solver lösen