Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
984to988
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
984to988
984to988
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Import nach 2 Kriterien
20.06.2008 15:52:00
Maris
Hallo liebe Vollprofis,
in den Zeilen meiner Tabelle Daten ist ein Kontenrahmen hinterlegt und in den Spalten sind Datumswerte (01.01.2008 usw.) hinterlegt. In einem anderen Tabellenblatt dessen Länge in den Zeilen(also unterschiedliche Konten in den Zeilen) variieren kann aber in der Struktur immer gleich bleibt. Sollen nun zum Datumswert des Tabellenblatts Import die Bewegungssummen in die entsprechende Zelle der Tabelle Daten importiert werden. Ist dort ein Wert vorhanden soll der importierte Wert hinzuaddiert werden... Ich hänge euch mal die Tabelle mit an damit ihr wißt wie ich es meine. Da ganze soll über einen importbutton laufen.
Wäre subba wenn ir jemand hier helfen könnte! Vielen Dank!
Gruß
Maris
https://www.herber.de/bbs/user/53225.xls

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Import nach 2 Kriterien
20.06.2008 17:51:00
fcs
Hallo Maris,
nach folgend ein Makro für den Datentransfer.
Lege in deiner Mappe einen Button aus der Symbolleiste Formular an und weise dann dieses Makro zu.
Gruß
Franz

Sub ImportNachDaten()
Dim wksDaten As Worksheet, wksImport As Worksheet
Dim datDatum As Date, bolDatum As Boolean
Dim varKonto As Variant, dblBewegung As Double, lngImport As Long
Dim lngSpalte As Long
Set wksDaten = Worksheets("Daten")
Set wksImport = Worksheets("Import")
'Datum im Blatt Import einlesen
datDatum = wksImport.Range("B1")
'Sicherheitsabfrage ob Aktion ausgeführt werden soll
If MsgBox(Prompt:="Wollen sie Daten für den " & Format(datDatum, "DD.MM.YYYY") _
& " aus dem Blatt Import nach Daten übertragen?", _
Buttons:=vbOKCancel, Title:="Daten von Import ---> Daten") = vbCancel _
Then GoTo Beenden
With wksDaten
'Spalte mit Datum im Blatt Daten ermitteln
For lngSpalte = 5 To .Cells(3, .Columns.Count).End(xlToLeft).Column
If .Cells(3, lngSpalte).Value = datDatum Then
bolDatum = True
Exit For
End If
Next
If bolDatum = False Then
MsgBox "Datum " & Format(datDatum, "DD.MM.YYYY") _
& " in Blatt Daten Zeile 3 nicht gefunden!"
Else
'zeilen im Blatt Import abarbeiten
For lngImport = 3 To wksImport.Cells(wksImport.Rows.Count, 1).End(xlUp).Row
varKonto = wksImport.Cells(lngImport, 1).Value    'Konto-Nr
dblBewegung = wksImport.Cells(lngImport, 3).Value 'Bewegungsumme
'Konto in Spalte 3 Blatt Daten suchen
Set objZelle = .Columns(3).Find(What:=varKonto, LookIn:=xlValues, lookat:=xlWhole)
If objZelle Is Nothing Then
MsgBox "Konto " & varKonto & " in Blatt Daten Spalte 3 nicht gefunden!"
Else
.Cells(objZelle.Row, lngSpalte).Value = .Cells(objZelle.Row, lngSpalte).Value _
+ dblBewegung
End If
Next
End If
End With
Beenden:
Set wksDaten = Nothing: Set wksImport = Nothing: Set objZelle = Nothing
End Sub


Anzeige
AW: Import nach 2 Kriterien
20.06.2008 20:40:04
Maris
Super Geil! Gibts eigentlich auch die Möglichkeit evtl. vorhandene Kommentare mitzukopieren?
Vielen Dank!

AW: Import nach 2 Kriterien
21.06.2008 16:54:00
fcs
Hallo Maris,
auch ein Kommentar kann zusammen mit den Werten aus dem Importblatt übertragen werden.
Ich hab das Makro angepasst.
Wenn für das Konto im Blatt Import ein Kommentar in der Spalte 3 (diese kannst du auch anders festlegen) eingetragen ist, dann wird der Kommentar ebenfalls in das Blatt Daten übertragen.
Ist für das Konto an dem Tag im blatt Daten schon ein Kommentar eingetragen, dann wird der neue Kommentar vor dem vorhandenen eingefügt. Zusätzlich wird das Datum des Imports vor dem Kommentar eingetragen.
Gruß
Franz

Sub ImportNachDaten()
Dim wksDaten As Worksheet, wksImport As Worksheet
Dim datDatum As Date, bolDatum As Boolean
Dim varKonto As Variant, dblBewegung As Double, lngImport As Long
Dim lngSpalte As Long, objZelle As Range
Dim bolKommentar As Boolean, strKommentar As String, objComment As Comment
Set wksDaten = Worksheets("Daten")
Set wksImport = Worksheets("Import")
Const lngSpalteKommentar As Long = 3 'Spalte im Blatt Import mit Kommentaren
'Datum im Blatt Import einlesen
datDatum = wksImport.Range("B1")
'Sicherheitsabfrage ob Aktion ausgeführt werden soll
If MsgBox(Prompt:="Wollen sie Daten für den " & Format(datDatum, "DD.MM.YYYY") _
& " aus dem Blatt Import nach Daten übertragen?", _
Buttons:=vbOKCancel, Title:="Daten von Import ---> Daten") = vbCancel _
Then GoTo Beenden
With wksDaten
'Spalte mit Datum im Blatt Daten ermitteln
For lngSpalte = 5 To .Cells(3, .Columns.Count).End(xlToLeft).Column
If .Cells(3, lngSpalte).Value = datDatum Then
bolDatum = True
Exit For
End If
Next
If bolDatum = False Then
MsgBox "Datum " & Format(datDatum, "DD.MM.YYYY") _
& " in Blatt Daten Zeile 3 nicht gefunden!"
Else
'zeilen im Blatt Import abarbeiten
For lngImport = 3 To wksImport.Cells(wksImport.Rows.Count, 1).End(xlUp).Row
varKonto = wksImport.Cells(lngImport, 1).Value    'Konto-Nr
dblBewegung = wksImport.Cells(lngImport, 3).Value 'Bewegungsumme
'prüfen, ob für Konto ein Kommentar in Spalte "Bewegung" vorhanden ist
bolKommentar = False
With wksImport.Cells(lngImport, lngSpalteKommentar)
If Not .Comment Is Nothing Then
bolKommentar = True
'Kommentartext zwischenspeichern
strKommentar = .Comment.Text
End If
End With
'Konto in Spalte 3 Blatt Daten suchen
Set objZelle = .Columns(3).Find(What:=varKonto, LookIn:=xlValues, lookat:=xlWhole)
If objZelle Is Nothing Then
MsgBox "Konto " & varKonto & " in Blatt Daten Spalte 3 nicht gefunden!"
Else
.Cells(objZelle.Row, lngSpalte).Value = .Cells(objZelle.Row, lngSpalte).Value _
+ dblBewegung
If bolKommentar = True Then
'Kommentar für Konto zum Datum setzen
Set objComment = .Cells(objZelle.Row, lngSpalte).Comment
If objComment Is Nothing Then
'Im Blatt Daten ist für Konto am Tag noch kein Kommentar vorhanden
'Kommentar aus Blatt Import kopieren
wksImport.Cells(lngImport, lngSpalteKommentar).Copy
.Cells(objZelle.Row, lngSpalte).PasteSpecial Paste:=xlPasteComments
Application.CutCopyMode = False
Set objComment = .Cells(objZelle.Row, lngSpalte).Comment
Else
With objComment
'neue Kommentarzeile(n) vor dem vorhandenen Kommentar einfügen
.Text Text:=strKommentar & Chr(10), Start:=1, overwrite:=False
'eingefügten Kommentar nicht fett formatieren
.Shape.TextFrame.Characters(1, Len(strKommentar) + 1).Font.Bold = False
End With
End If
With objComment
'Aktuelles Datum vor dem Kommentar einfügen
.Text Text:=Format(Date, "YYYY-MM-DD "), Start:=1, overwrite:=False
'Datum fett formatieren
.Shape.TextFrame.Characters(1, 10).Font.Bold = True
End With
End If
End If
Next
End If
End With
Beenden:
Set wksDaten = Nothing: Set wksImport = Nothing: Set objZelle = Nothing
Set objComment = Nothing
End Sub


Anzeige

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige