Scan in next leere Zelle einer Spalte u. Bestandsführung

[Wolfgang Hackbeil]

Hallo Zusammen,  vorab möchte ich noch ein erfolgreiches neues Jahr bei guter Gesundheit wünschen.
Ich hatte vor kurzem zu o.g. Thema schon einmal einen "Hilferuf" losgelassen und sehr schnell eine funktionierende Lösung vom Forum-Nutzer "UWE" bekommen. Zwischenzeitlich habe ich mit der Lösung gearbeitet. Einige Abläufe haben sich leicht verändert und aus der 2-monatigen Praxis hätte ich gerne noch einmal Hilfe bei der Datei mit Makro-Unterstützung. 
Der Einfachheit halber habe ich meine Datei beigefügt und in dem ersten Arbeitsblatt meine "Wünsche" in einer Kommentar-Zelle beschrieben.
Wie schon erwähnt bin ich mit 75 Jahren ein älteres Semester und arbeite viel und intensiv mit Excel. An Makro`s habe ich mich noch nicht herangetraut. Was ich aber jetzt angehen will. Doch erst einmal benötige Unterstützung.
Über Eure Hilfe zu diesem Thema würde ich mich sehr freuen.
Wolfgang

[Käpt'n Blaubär]

Hallo Wolfgang,

... hätte ich gerne noch einmal Hilfe bei der Datei mit Makro-Unterstützung. 

toll, in der *.xlsx-Datei kann es aber keine Makros geben.
Wenn Du also Makro-Unterstützung willst, dann speichere die Datei vor dem Hochladen als *.xlam oder *.xlsb.

Im Übrigen ... mit Deinen 75 Jahren bist Du ganz sicher nicht der Älteste hier. Also kein Grund zum Kokettieren.
Für mich selbst gilt Jahrgang 1946.

[WillWissen]

Hi Peter,

dann speichere die Datei vor dem Hochladen als *.xlam oder *.xlsb.

ist .xlam nicht für AddIns reserviert und für normale Dateien mit Makros .xlsm oder xlsb?

[Käpt'n Blaubär]

Hallo Günter,

ist .xlam nicht für AddIns reserviert und für normale Dateien mit Makros .xlsm oder xlsb?

braver Junge, .... gut aufgepaßt.
Ja, ja, das sind die schnellen Fingerchen.
Natürlich sollte es *.xlsm heißen.

[Wolfgang Hackbeil]

Hallo,
habe die Datei neu angehängt in xlsm, sorry ich wollte nicht mit meinem Alter kokettieren sondern nur aufzeigen " alt/älter aber keine keine Ahnung von Makro`s". 
Danke für den Hinweis der Dateiform. 
Gruß Wolfgang

[Kuwer]

Hallo Wolfgang,

Microsoft Excel Objekt Tabelle5

Option Explicit 



Private Sub Worksheet_Change(ByVal Target As Range) 

 With Target.Cells(1) 

   If .Row > 2 Then 

     Select Case .Column 

       Case 1 

         If Len(.Value) Then 

           .Offset(, 2).Value = Mid(.Value, 4, 5) 

         Else 

           .Offset(, 2).Select 

         End If 

       Case 2 

         If IsDate(.Value) Then 

           .Offset(, -1).Resize(, 3).Copy Worksheets("Archivierung").Cells(Rows.Count, 3).End(xlUp).Offset(1, -2) 

         End If 

       Case 3 

         If Len(.Value) Then 

           .Offset(, -1).NumberFormat = "dd.mm.yyyy hh:mm" 

           .Offset(, -1).Value = Now 

           .Offset(, -2).Select 

         End If 

       Case 5 

         If Len(.Value) Then 

           .Offset(, 1).Value = Application.Index(Range("$A$3:$A$500"), Application.Match(.Value, Range("$C$3:$C$500"), 0)) 

           If Not IsError(.Offset(, 1).Value) Then 

             .Offset(, 2).NumberFormat = "dd.mm.yyyy hh:mm" 

             .Offset(, 2).Value = Now 

             .Resize(, 3).Copy Worksheets("Archivierung").Cells(Rows.Count, 7).End(xlUp).Offset(1, -2) 

           End If 

         End If 

     End Select 

   End If 

 End With 

End Sub 



Private Sub Worksheet_SelectionChange(ByVal Target As Range) 

 If Target.Column = 1 Then 

   On Error Resume Next 

   Application.EnableEvents = False 

   Range("$C$3:$C$500").SpecialCells(xlCellTypeBlanks).Cells(1).Offset(0, -2).Select 

   ActiveCell.Calculate 

   Application.EnableEvents = True 

   On Error GoTo 0 

 End If 

End Sub 

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 14 - mit VBAHTML 12.6.0

Modul Modul1

Option Explicit 



Sub Textfeld2_Klicken() 

 Dim rngAusgang As Range 

 Dim rngEingang As Range 

 Dim rngZelle As Range 

  

 Set rngAusgang = Range("$E$3:$E$500") 

 Set rngEingang = Range("$C$3:$C$500") 

  

 For Each rngZelle In rngAusgang 

   If Len(rngZelle.Value) Then 

     rngEingang.Cells(Application.Match(rngZelle.Value, rngEingang, 0)).Offset(, -2).Resize(, 3) = "" 

     rngZelle.Resize(, 3) = "" 

   End If 

 Next rngZelle 

End Sub 

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 14 - mit VBAHTML 12.6.0

Gruß Uwe

[Wolfgang Hackbeil]

Hallo Uwe,
wow, wow, ich bin nicht nur beeindruckt sondern begeistert. Ich habe Deine Makro bzw. die Datei mit Deinem Makro ausgiebig getestet. Alles, aber auch alles passt super!! 

Besten Dank!! Deine Arbeit erspart mir viel Arbeit. Gibt es irgendeine Adresse wo ich mich mit einer kleinen Spende in Deinem Namen bedanken kann? Bei aller Hilfestellungen im Forum, das ging über etwas Hilfe schon m.E. weit hinaus.
Ich habe von Dir gleich ein fertiges "Produkt" erhalten. Nochmals danke 

Wolfgang


PS: Wenn ich die Ausgangs-Lfs.-Nr. als ok frei gebe, löscht das System diese - wie gewünscht und archiviert diese in der Archivdatei-. Kann man u.U. die Eingabezellen(Zeilen), die durch diesen Vorgang wieder frei werden, durch aufrücken der darunter stehenden Einträge bündig schließen?

[WillWissen]

Hi Wolfgang,

ich habe zu deiner eigenen Sicherheit deine E-Mailadresse aus dem Beitrag rausgenommen. Falls du sie jemandem zukommen lassen willst, ist es besser, dies per PN zu machen.

[Wolfgang Hackbeil]

Hallo,

danke,  war im "Überschwang" der Freude über die erfolgreiche Hilfe sicherlich unüberlegt.

Wolfgang

[Kuwer]

Hallo Wolfgang,

das freut mich, wenn alles so passt.

PS: Wenn ich die Ausgangs-Lfs.-Nr. als ok frei gebe, löscht das System diese - wie gewünscht und archiviert diese in der Archivdatei-. Kann man u.U. die Eingabezellen(Zeilen), die durch diesen Vorgang wieder frei werden, durch aufrücken der darunter stehenden Einträge bündig schließen?

Modul Modul1

Option Explicit 



Sub Textfeld2_Klicken() 

 Dim lngX As Long, lngY As Long 

 Dim rngAusgang As Range, rngEingang As Range 

 Dim rngZelle As Range 

 Dim varEin As Variant, varAus As Variant 

  

 Set rngAusgang = Range("$E$3:$E$500") 

 Set rngEingang = Range("$C$3:$C$500") 

  

 For Each rngZelle In rngAusgang 

   If Len(rngZelle.Value) Then 

     If Not IsError(rngZelle.Offset(, 1).Value) Then 

       If Len(rngZelle.Offset(, 1).Value) Then 

         rngEingang.Cells(Application.Match(rngZelle.Value, rngEingang, 0)).Offset(, -2).Resize(, 3) = "" 

         rngZelle.Resize(, 3) = "" 

       End If 

     End If 

   End If 

 Next rngZelle 

  

 varEin = rngEingang.Offset(, -2).Resize(, 3).Value 

 Redim varAus(1 To Ubound(varEin, 1), 1 To Ubound(varEin, 2)) 

 For lngX = 1 To Ubound(varEin) 

   If Len(varEin(lngX, 3)) Then 

     lngY = lngY + 1 

     varAus(lngY, 1) = varEin(lngX, 1) 

     varAus(lngY, 2) = varEin(lngX, 2) 

     varAus(lngY, 3) = varEin(lngX, 3) 

   End If 

 Next lngX 

 rngEingang.Offset(, -2).Resize(, 3).Value = varAus 

End Sub 

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 14 - mit VBAHTML 12.6.0

Die Archivierung erfolgt(e) aber schon vorher unabhängig vom OK-Klick.

Gruß Uwe