florian86
Goto Top

Excel Makro Problem

Hallo,

ich habe folgendes vor:

ich möchte in einer Exceldatei mit 2 Blättern auf den ersten ein kleines Formular basteln.
Dieses soll ein Button enthalten welches die eingegebenen Daten auf das 2. Tabellenblatt überträgt.

Als Link meine Datei...

https://drive.google.com/file/d/0BzQM-ZoFrfL8bVlzTzlpa0Z2WVk/view?usp=sh ...

Ich habe die Datei fast fertig nur funktioniert mein Button und das dahinterstehende Makro nicht.

Mein Code

Private Sub CommandButton1_click()
Dim wksOrig As Worksheet
Dim wksStore As Worksheet
Dim lngLastRow As Long

Set wksOrig = Worksheets("PK frisch")
Set wksStore = Worksheets("Datenmatrix")

With wksStore
lngLastRow = IIf(.Cells(Rows.Count, 1) = "", .Cells(Rows.Count, 1).End(xlUp).Row + 1, Rows.Count)
.Cells(lngLastRow, 1) = wksOrig.Range("D8")
.Cells(lngLastRow, 2) = wksOrig.Range("F8")

End With

Set wksStore = Nothing
Set wksOrig = Nothing
End Sub


MfG

Florian

Content-Key: 252314

Url: https://administrator.de/contentid/252314

Printed on: April 19, 2024 at 10:04 o'clock

Member: Meierjo
Solution Meierjo Oct 17, 2014 updated at 17:07:59 (UTC)
Goto Top
Hallo

Also, hab mir die Tabelle mal angeschaut.
Sobald du in der Tabelle Datenmatrix in Feld A5 etwas stehen hast, werden die Werte aus der Eingabe-Box korrekt in die Zieltabelle übertragen.
Vermutlich ein Problem, weil die Zeilen 3 und 4 verbunden sind, kann die letzte Zeile mit Inhalt nicht richtig ermittelt werden.

Gruss Urs
Member: colinardo
Solution colinardo Oct 17, 2014 updated at 17:07:56 (UTC)
Goto Top
Hallo Florian,
es ist genau die Ursache die Urs ermittelt hat, die verbundene Zelle(A3:A4) auf dem Tabellenblatt Datenmatrix. Schreibe diese Zeile deines Codes folgendermaßen um, dann klappt's wie gewünscht:
lngLastRow = IIf(.Cells(Rows.Count, 1) = "", .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row, Rows.Count)
Mit .Offset(1,0) verschiebst du den Zeiger der Zelle wirklich um eine Zelle nach unten, verbundene Zellen werden damit berücksichtigt.

Grüße Uwe
Member: Florian86
Florian86 Oct 17, 2014 at 17:08:21 (UTC)
Goto Top
Danke für eure Antworten....
Member: Florian86
Florian86 Oct 20, 2014 at 06:26:35 (UTC)
Goto Top
Hallo,

eine Frage noch...

Wenn ich im ersten Tabellenblatt eine laufende Nummer einfüge und diese auch als Spalte in dem 2 Tabellenblatt,
Könnte man dann sogar über die laufenden Nr. definieren an welcher stelle Excel die Zellen kopieren soll???

Sollte dann wie in der Tabelle so aussehen...

https://drive.google.com/file/d/0BzQM-ZoFrfL8SlltTjNoZnc3XzQ/view?usp=sh ...

MfG

Florian
Member: colinardo
Solution colinardo Oct 20, 2014 updated at 10:07:56 (UTC)
Goto Top
Zitat von @Florian86:
Wenn ich im ersten Tabellenblatt eine laufende Nummer einfüge und diese auch als Spalte in dem 2 Tabellenblatt,
Könnte man dann sogar über die laufenden Nr. definieren an welcher stelle Excel die Zellen kopieren soll???
selbst redend face-wink
Private Sub CommandButton1_click()
 Dim wksOrig As Worksheet, wksStore As Worksheet, found As Range
 
 Set wksOrig = Worksheets("PK frisch")  
 Set wksStore = Worksheets("Datenmatrix")  
 
 With wksStore
    lfdNummer = wksOrig.Range("D5").Value  
    Set found = .Range("A5", .Cells(Rows.Count, 1)).Find(lfdNummer, LookIn:=xlValues, Lookat:=xlWhole)  
    If Not found Is Nothing Then
        found.Offset(0, 1).Value = wksOrig.Range("D8")  
        found.Offset(0, 2).Value = wksOrig.Range("F8")  
    End If
 End With
 
 Set wksStore = Nothing
 Set wksOrig = Nothing
End Sub
Grüße Uwe
Member: Florian86
Florian86 Oct 20, 2014 at 10:08:15 (UTC)
Goto Top
hat super geklappt Danke dir...

MfG

Florian86
Member: Florian86
Florian86 Nov 18, 2014 at 14:28:36 (UTC)
Goto Top
Hallo,

kann man auch sagen wenn in der Zeile etwas geschrieben ist das er dann eine Meldung bringen und abbrechen soll???

Mein Code sieht dazu nun so aus:

Private Sub CommandButton1_Click()

Dim wksOrig As Worksheet, wksStore As Worksheet, found As Range, foundb As Range

Set wksOrig = Worksheets("PK frisch")
Set wksStore = Worksheets("Datenmatrix")

If MsgBox("Bitte Prüfen Sie die lfd. Nummer. Möchten Sie die Daten wirklich übernehmen?", vbYesNo) = vbYes Then
With wksStore

lfdNummer = wksOrig.Range("C6").Value
zeilegefüllt = wksOrig.Range("B5:B5000").Value

Set foundb = .Range("B5", .Cells(Rows.Count, 1)).Find(zeilegefüllt, LookIn:=xlValues, Lookat:=xlWhole)
Set found = .Range("A5", .Cells(Rows.Count, 1)).Find(lfdNummer, LookIn:=xlValues, Lookat:=xlWhole)

If Not found Is Nothing And foundb = "" Then

found.Offset(0, 1) = wksOrig.Range("C8")
found.Offset(0, 2) = wksOrig.Range("K8")

Else
MsgBox "lfd Nummer ist schon vergeben!!!", vbExclamation

End If

End With

Else
End If

Set wksStore = Nothing
Set wksOrig = Nothing
End Sub

Ich wollte halt sagen wenn er die lfdnr. findet UND in Spalte B nix steht ist alles ok.
Wenn in Spalte B etwas drin steht soll er die Meldung bringen das da schon was drin ist.
Member: colinardo
Solution colinardo Nov 18, 2014 updated at 17:04:23 (UTC)
Goto Top
Zitat von @Florian86:
Ich wollte halt sagen wenn er die lfdnr. findet UND in Spalte B nix steht ist alles ok.
Wenn in Spalte B etwas drin steht soll er die Meldung bringen das da schon was drin ist.
Private Sub CommandButton1_Click()
    Dim wksOrig As Worksheet, wksStore As Worksheet, found As Range
    
    Set wksOrig = Worksheets("PK frisch")  
    Set wksStore = Worksheets("Datenmatrix")  
    
    If MsgBox("Bitte Prüfen Sie die lfd. Nummer. Möchten Sie die Daten wirklich übernehmen?", vbYesNo Or vbQuestion) = vbYes Then  
        With wksStore
            lfdNummer = wksOrig.Range("C6").Value  
            Set found = .Range("A5", .Cells(Rows.Count, 1)).Find(lfdNummer, LookIn:=xlValues, Lookat:=xlWhole)  
        
            If Not found Is Nothing Then
                If found.Offset(0, 1).Value <> "" Then  
                    MsgBox "lfd Nummer ist schon vergeben!!!", vbExclamation  
                    Exit Sub
                Else
                    found.Offset(0, 1) = wksOrig.Range("C8")  
                    found.Offset(0, 2) = wksOrig.Range("K8")  
                End If
            Else
                MsgBox "Laufende Nummer wurde nicht gefunden", vbCritical  
            End If
        End With

    End If
    
    Set wksStore = Nothing
    Set wksOrig = Nothing
End Sub
Grüße Uwe
Member: Florian86
Florian86 Nov 18, 2014 at 17:05:53 (UTC)
Goto Top
Danke

MfG

Florian86