Problem mit dem richtigen einfügen von Daten

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
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

Beiträge aus den Excel-Beispielen zum Thema " Problem mit dem richtigen einfügen von Daten"