Daten übertragen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox


Excel-Version: 2000
nach unten

Betrifft: Daten übertragen
von: Michael
Geschrieben am: 28.04.2002 - 17:09:22

Hallo,
Habe eine Ziel- und eine Datentabelle, in beiden sind in der spalte A Artikelnummern. Die Inhalte der Spalten B unc C sollen nun von der Datentabelle in die Zieltabelle übertragen werden - natürlich der richtigen Artikelnummer zugeordnet. Wenn es die Artikelnummer in der Zieltabelle nicht gibt soll der Artikel dort in der 1. leeren Zeile eingefügt werden.

Wer kann mir helfen?
Vielen Dank

Michael


nach oben   nach unten

Re: Daten übertragen
von: WernerB.
Geschrieben am: 28.04.2002 - 18:42:34

Hallo Michael, ich bin gespannt, wie Dir dieses Makro gefällt:
Option Explicit Sub DatenUebertragen() Dim wksQ As Worksheet, wksZ As Worksheet Dim SuBe As Range Dim As String Dim As Long, larQ As Long, laR1 As Long, laR2 As Long, laR3 As Long     Set wksQ = ThisWorkbook.Worksheets("Tabelle1")     Set wksZ = ThisWorkbook.Worksheets("Tabelle2")     larQ = wksQ.Cells(Rows.Count, 1).End(xlUp).Row     For i = 2 To larQ       s = wksQ.Cells(i, 1).Value       With wksZ         laR1 = .Cells(Rows.Count, 1).End(xlUp).Row         Set SuBe = .Range(.Cells(2, 1), .Cells(laR1, 1)). _           Find(s, lookat:=xlWhole)         If Not SuBe Is Nothing Then           .Cells(SuBe.Row, 2).Value = wksQ.Cells(i, 2).Value           .Cells(SuBe.Row, 3).Value = wksQ.Cells(i, 3).Value         Else           laR2 = .Cells(Rows.Count, 2).End(xlUp).Row           laR3 = laR1           If laR2 > laR3 Then laR3 = laR2           .Cells(laR3 + 1, 2).Value = wksQ.Cells(i, 2).Value           .Cells(laR3 + 1, 3).Value = wksQ.Cells(i, 3).Value         End If       End With     Next i End Sub
Viel Erfolg wünscht WernerB.

nach oben   nach unten

Re: Daten übertragen
von: Michael
Geschrieben am: 28.04.2002 - 20:58:24

Hallo Werner, hast Du super gelöst !!!! Ich hab allerdings noch ein Problem. Ich hab unten in der Zieltabelle noch eine Summenzeile. Ein neuer Artikel soll nicht nach der letzten Zeile sondern in die erste freie Zeile - inkl. der Artikelnummer eingetragen werden. Weist Du dafür auch noch einen Rat ? Wenn nicht, dann trotzdem vielen Dank, Du hast mir sehr geholfen. Gruß Michael

nach oben   nach unten

Re: Daten übertragen
von: WernerB.
Geschrieben am: 28.04.2002 - 22:05:15

Hallo Michael, ist es das, was Du gemeint hast:
Sub DatenUebertragen() Dim wksQ As Worksheet, wksZ As Worksheet Dim SuBe As Range, c As Range Dim As String Dim As Long, larQ As Long, laR1 As Long, laR2 As Long, _     laR3 As Long, frR As Long Dim platz As Boolean     Set wksQ = ThisWorkbook.Worksheets("Tabelle1")     Set wksZ = ThisWorkbook.Worksheets("Tabelle2")     larQ = wksQ.Cells(Rows.Count, 1).End(xlUp).Row     laR1 = wksZ.Cells(Rows.Count, 1).End(xlUp).Row     For i = 2 To larQ       s = wksQ.Cells(i, 1).Value       With wksZ         Set SuBe = .Range(.Cells(2, 1), .Cells(laR1, 1)). _           Find(s, lookat:=xlWhole)         If Not SuBe Is Nothing Then           .Cells(SuBe.Row, 2).Value = wksQ.Cells(i, 2).Value           .Cells(SuBe.Row, 3).Value = wksQ.Cells(i, 3).Value         Else           platz = False           laR2 = .Cells(Rows.Count, 2).End(xlUp).Row           laR3 = laR1           If laR2 > laR3 Then laR3 = laR2           For Each c In .Range("A2:A" & laR3)             If IsEmpty(c.Value) And IsEmpty(c.Offset(0, 1).Value) Then               frR = c.Row               platz = True               Exit For             End If           Next c           If platz = True Then             .Cells(frR, 2).Value = wksQ.Cells(i, 2).Value             .Cells(frR, 3).Value = wksQ.Cells(i, 3).Value           Else             MsgBox "Kein freier Platz für Artikel ohne Artikelnummer !", _               vbExclamation, "Hinweis für " & Application.UserName & ":"           End If         End If       End With     Next i End Sub
Viel Erfolg wünscht WernerB.

nach oben   nach unten

Re: Daten übertragen
von: Michael
Geschrieben am: 30.04.2002 - 20:57:26

Danke, klappt super

mir ist nur nicht ganz klar was dieser part für eine Bedeutung hat:
laR3 = laR1
If laR2 > laR3 Then laR3 = laR2
For Each c In .Range("A2:A" & laR3)
If IsEmpty(c.Value) And IsEmpty(c.Offset(0,1).Value) Then
frR = c.Row

Gruß

Michael

nach oben   nach unten

Re: Daten übertragen
von: WernerB.
Geschrieben am: 30.04.2002 - 22:05:59

Hallo Michael,

für den Fall, dass Daten ohne Artikelnummer in die Ziel-Tabelle übertragen werden sollen, muss die erste freie Zeile dafür gefunden werden. Da ich nicht wissen kann (habe keine Glaskugel), in welcher Zeile Deine Summenbildungen stattfinden, ermittle ich eben diese (Variable "laR3"). "lar1" ist die letzte Zeile mit Inhalt in der Spalte A, "laR2" ist die letzte Zeile mit Inhalt in der Spalte B. Der größere der beiden Werte wird dann in "laR3" übernommen.

In der For-Each-Schleife wird dann die erste freie Zeile gesucht; genau genommen wird nur nach der ersten Zeile gesucht, in der eine Zelle der Spalte A und die daneben liegende Zelle in der Spalte B (Offset(0,1)) leer sind.
Der zu durchsuchende Bereich wird vorher festgelegt: Range("A2:A" & laR3); wenn Deine Summenbildung z.B. in Zeile 150 stattfindet, dann also "A2:A150". Durch die die Offset-Anweisung wird die Spalte B auch mit einbezogen, so dass tatsächlich der Bereich "A2:B150" durchsucht wird. Wenn die ersten beiden nebeneinander liegenden leeren Zellen in diesem Bereich gefunden werden (frR = c.Row), wird die For-Each-Schleife abgebrochen und die Werte in dieser Zeile (Spalte A bleibt frei) eingetragen.

Ich hoffe, die Beschreibung ist verständlich; falls nicht, oder noch Fragen offen sind, so melde Dich einfach noch mal.

MfG
WernerB.

 nach oben

Beiträge aus den Excel-Beispielen zum Thema "Excel Tabelle für Sportwetten-Quoten!!! Denksport "