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

Ausgedruckt am: 28.03.2024 um 11:03 Uhr

Mitglied: Meierjo
Lösung Meierjo 17.10.2014 aktualisiert um 19:07:59 Uhr
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
Mitglied: colinardo
Lösung colinardo 17.10.2014 aktualisiert um 19:07:56 Uhr
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
Mitglied: Florian86
Florian86 17.10.2014 um 19:08:21 Uhr
Goto Top
Danke für eure Antworten....
Mitglied: Florian86
Florian86 20.10.2014 um 08:26:35 Uhr
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
Mitglied: colinardo
Lösung colinardo 20.10.2014 aktualisiert um 12:07:56 Uhr
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
Mitglied: Florian86
Florian86 20.10.2014 um 12:08:15 Uhr
Goto Top
hat super geklappt Danke dir...

MfG

Florian86
Mitglied: Florian86
Florian86 18.11.2014 um 15:28:36 Uhr
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.
Mitglied: colinardo
Lösung colinardo 18.11.2014 aktualisiert um 18:04:23 Uhr
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
Mitglied: Florian86
Florian86 18.11.2014 um 18:05:53 Uhr
Goto Top
Danke

MfG

Florian86