Thema Datum  Von Nutzer Rating
Antwort
Rot Archiv mit Such und Aktualisierfunktion
 16.11.2019 10:00:58 Dennis
NotSolved
16.11.2019 18:40:11 Gast84573
NotSolved

Ansicht des Beitrags:
Von:
Dennis		 Datum:
16.11.2019 10:00:58		 Views:
859		 Rating:
     
Antwort:
  Ja
Thema:
Archiv mit Such und Aktualisierfunktion

Hallo zusammen,

 

ich habe folgendes Problem…

 

Per Button sollen 4 Werte aus dem Sheet ZP in den Sheet Archiv kopiert werden.

Vor dem Kopieren soll geschaut werden, ob der Wert3 oder Wert4 schon im Archiv vorhanden ist.

Wenn vorhanden, sollen die Werte in der Spalte aktualisiert werden.

Wenn nicht vorhanden, soll die nächste leere Spalte gesucht werden.

 

Jetzt kommt für mich das Problem… Es ist im Normalfall nur Wert3 oder Wert4 vorhanden. Die andere Zelle bleibt leer.

Egal wie ich es mit meinen Einsteiger Kenntnissen versuche, entweder kommt gleich eine Fehlermeldung oder es wird permanent in Zeile 1 kopiert.

Ich denke mal, es liegt daran, dass der nicht vorhandene Wert aus der anderen Zelle gesucht wird aber sicher bin ich mir da auch nicht.

 

Hier mal der Code:

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
Sub Archivieren()
 
Dim Wert3 As String
Dim Wert4 As String
Wert3 = Sheets("ZP").Range("C8")
Wert4 = Sheets("ZP").Range("C9")
Set ZP = Sheets("ZP")
Set Archiv = Sheets("Archiv")
 
         
Sheets("Archiv").Select
Range("A1").Select
 
Kennzeichen:
On Error Resume Next
If IsEmpty(Sheets("ZP").Range("C8")) = False Then
  Cells.Find(What:=Wert3, After:=ActiveCell, LookIn:=xlFormulas, _
  LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
  MatchCase:=False, SearchFormat:=False).Select
  Selection.Offset(0, -2).Select
  GoTo Copy
  Else
  GoTo Behälter
   
    If Err.Number = 91 Then
        GoTo Behälter
    End If
End If
On Error GoTo 0
 
Behälter:
On Error Resume Next
If IsEmpty(Sheets("ZP").Range("C9")) = False Then
  Cells.Find(What:=Wert4, After:=ActiveCell, LookIn:=xlFormulas, _
  LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
  MatchCase:=False, SearchFormat:=False).Select
  Selection.Offset(0, -2).Select
  GoTo Copy
   
    If Err.Number = 91 Then
        GoTo Search
    End If
End If
On Error GoTo 0
 
Search:
If Selection.Offset(0, 2).Value <> "" Or Selection.Offset(0, 3).Value <> "" Then
    Selection.Offset(1, 0).Select
    GoTo Search
End If
     
Copy:
Selection.Offset(0, 0).Value = Sheets("ZP").Range("G1").Value 'Datum
Selection.Offset(0, 1).Value = Sheets("ZP").Range("C4").Value 'Referenz
Selection.Offset(0, 2).Value = Sheets("ZP").Range("C8").Value 'Kennzeichen
Selection.Offset(0, 3).Value = Sheets("ZP").Range("C9").Value 'Behälter
 
Sheets("ZP").Select
ActiveWorkbook.Save
 
End Sub

 

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Archiv mit Such und Aktualisierfunktion
 16.11.2019 10:00:58 Dennis
NotSolved
16.11.2019 18:40:11 Gast84573
NotSolved