Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1444to1448
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Daten erkennen, kopieren u. mehrfach einfügen

Daten erkennen, kopieren u. mehrfach einfügen
03.09.2015 21:35:16
Max
Hallo zusammen, ich hab leider bisher wenig Erfahrung mit VBA Makros und eigentlich alles durch learning by doing erlernt. Doch bei der jetzigen Problematik stoße ich so an meine Grenzen und hoffe hier ein wenig Hilfe zu bekommen.
Nun also zu meinem Problem: Ich habe in einem Datenblatt Einstellungen eine mit Spalte Lohnarten angegeben und in einem anderen Datenblatt variabel je nach Monat Personalnummern. Neben jeder Personalnummer müssen nun alle Lohnarten einmal in die nächste Zeile kopiert werden. Die Anzahl der Lohnarten ist dabei variabel, der Code sollte also in der Lage sein, zu erkennen wieviele Daten es sind und diese dann kopieren. Die Anzahl der Personalnummern ist ebenfalls variabel und daher müssten auch beliebig oft die kopierten Daten eingefügt werden.
Ich hoffe, ich konnte die Aufgabenstellung halbwegs präzise erläutern.
Viele Grüße,
Max

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten erkennen, kopieren u. mehrfach einfügen
04.09.2015 06:42:39
fcs
Hallo Max,
erstelle mal eine Datei mit Beispieldaten mit folgenden Blättern
- Blatt "Einstellungen" mit Spalte Lohnarten - variablen Bereich kennzeichnen bzw. max. Anzahl Lohnarten angeben.
- Monatsblatt mit Personalnummern (ca. 5 Nummern reichen) vor der Ausführung des Makros
- Monatsblatt mit Personalnummern + Lohnarten wie es nach Ausführung des Makros aussehen soll
Lade die Datei dann hier hoch, dann ist es einfacher dir zu helfen.
Gruß
Franz

AW: Daten erkennen, kopieren u. mehrfach einfügen
07.09.2015 17:19:46
Max
So, es tut mir leid, ich bin erst jetzt dazu gekommen mich hier wieder zu melden. Hier sollte jetzt die Datei mit meinen bisherigen Progammiererfolgen zu finden sein https://www.herber.de/bbs/user/100067.xlsm
Das Startblatt dient einfach dazu, den Monat auszuwählen. Der aktuelle Monat sollte nicht automatisch ermittelt werden, da die Daten erst nachträglich bearbeitet werden. Weiterhin kann das Einstellungsblatt nur mit Passwort geöffnet werden, da nur einer die "Einstellungen" anspassen soll. Die Olivgrüne Spalte sollte variabel sein, also ständig manuell angepasst werden können. Ich denke der Rest ist soweit schon erklärt worden. Das Endergebnis soll dann im Tabellenblatt Monat A stehen. Gibt es eine Möglichkeit, dass das Makro prüft ob dieser Name schon vorhanden ist und wenn ja, dann automatisch den nächsten Buchstaben wählt (also Monat B)? Weiterhin habe ich die Frage, wie man automatisch die Buchstaben aus der Lohnart im Zielblatt löscht, da nur die Zahlen für den Upload in das Lohnprogramm benötigt werden.
Viele Grüße,
Max

Anzeige
AW: Daten erkennen, kopieren u. mehrfach einfügen
08.09.2015 18:31:01
fcs
Hallo Max,
hier das entsprechende Makro angepasst plus eine Function, die prüft ob ein Blatt mit einem schon vorhanden ist.
Gruß
Franz
Private Sub Datenaufbereitung()
Dim wksNeu As Worksheet
Dim rngLohnart As Range
Dim ZeileNeu As Long
On Error GoTo Fehler
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Bereich mit Lohnarten merken
With ActiveWorkbook.Worksheets("Einstellungen")
Set rngLohnart = .Range(.Cells(2, 3), .Cells(.Rows.Count, 3).End(xlUp))
If rngLohnart.Row = 1 Then
MsgBox "Im Blatt ""Einstellungen"" sind keine Lohnarten eingegeben!"
GoTo Beenden
End If
End With
'Variable Monat ermitteln
Monat = Worksheets("Startblatt").Range("C7").Value
If fncCheckSheetname(Monat) = False Then
MsgBox "Das Blatt mit den Daten für Monat """ & Monat & """ existiert noch nicht!"
GoTo Beenden
End If
'Variable MonatA ermitteln
lngZeile = 65 '"A" = 65. Buchstabe im Zeichensatz
Do Until fncCheckSheetname(Monat & " " & Chr(lngZeile)) = False
lngZeile = lngZeile + 1
If lngZeile = 91 Then
MsgBox "Blattzählung für """ & Monat & """ ist bei ""Z"" angekommen!"
GoTo Beenden
End If
Loop
MonatA = Monat & " " & Chr(lngZeile)
'Erstellen und benennen des Datenblattes mit der Auswertung
With ActiveWorkbook
.Worksheets.Add after:=.Sheets(.Sheets.Count)
End With
Set wksNeu = ActiveSheet
With wksNeu
.Name = MonatA
'Spaltentitel eintragen
.Range("A1").Value = "Personalnummer"
.Range("B1").Value = "Lohnart"
.Range("C1").Value = "Wert"
'Fenster fixieren unter Spaltentitel
.Range("A2").Select
ActiveWindow.FreezePanes = True
'Personalnummern und Lohnarten übertragen
ZeileNeu = 2
With ActiveWorkbook.Worksheets(Monat)
For lngZeile = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
wksNeu.Cells(ZeileNeu, 1).Resize(rngLohnart.Rows.Count, 1) = _
.Cells(lngZeile, 1).Value
wksNeu.Cells(ZeileNeu, 2).Resize(rngLohnart.Rows.Count, 1).Value2 = _
rngLohnart.Value2
ZeileNeu = ZeileNeu + rngLohnart.Rows.Count
Next lngZeile
End With
'Werte ermitteln per Formel
With .Range(.Cells(2, 3), .Cells(ZeileNeu - 1, 3))
.FormulaR1C1 = "=VLOOKUP(RC[-2],'" & Monat & "'!R1:R1048576," _
& "MATCH(RC[-1],'" & Monat & "'!R1,0),FALSE)"
.Calculate
'Formeln durch Werte ersetzen
.Value = .Value
End With
'Spalte mit Lohnarten wieder löschen
.Columns(2).Delete shift:=xlToLeft
'Autofilter einrichten
.Range(.Cells(1, 1), .Cells(ZeileNeu - 1, 2)).AutoFilter
End With
Beenden:
Err.Clear
Fehler:
With Err
Select Case .Number
Case 0 'Alles OK
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
vbOKOnly + vbCritical, "Fehler Makro: Datenaufbereitung"
End Select
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Public Function fncCheckSheetname(ByVal strSheet As String, _
Optional wkb As Workbook) As Boolean
'Prüft, ob ein Blatt mit dem Namen in der Arbeitsmappe schon vrhanden ist
'True = Blatt vorhanden
'False = Blatt nicht vorhanden
On Error GoTo Fehler
If wkb Is Nothing Then Set wkb = ActiveWorkbook
Set objSheet = wkb.Sheets(strSheet)
fncCheckSheetname = True
Exit Function
Fehler:
fncCheckSheetname = False
End Function

Anzeige
AW: Daten erkennen, kopieren u. mehrfach einfügen
08.09.2015 21:26:05
Max
Hallo Franz,
das ist ja super! Funktioniert tadellos. Vielen lieben Dank!
Gruß,
Max

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige