Schleife von einem Register zu einem anderen

22.11.2024 13:08:52

Hallo Liebe Gemeinde

Ich stehe total auf dem Schlauch
Ich würde gerne mit einer Imput Box die Referenznummer eingeben zum beispiel A200
Danach soll die Prozedur zuerst die Referenznummer wo man eingibt in die Zieldatei eingetragen werden beginnend in Spalte E1 aber nur wenn die E1 leer ist sonst eins nach rechts F1 und so weiter bis Y1

Danach soll die schleife beginnend mit der Zeile 2 der Artikel von der Spalte C in der Zieldatei gesucht werden und die Menge eingetragen werden in der Spalte E wenn die Referenz dann zum Besipiel A300 wäre dann in die nächste Spalte F

Zur besseren Erklärung hab ich mal eine Beispieldatei erstellt.
https://www.herber.de/bbs/user/173771.xlsx

Gruss Hans

AW: Schleife von einem Register zu einem anderen

22.11.2024 15:21:35

ReginaR

Hi,
schau mal, ob Du damit weiterkommst:





Public Sub Uebertrag()

Dim obj_wkb_ziel As Workbook

Dim obj_wkb_quelle As Workbook

Dim obj_wks_quelle As Worksheet

Dim obj_wks_ziel As Worksheet

Dim lng_zeile_quelle As Long

Dim lng_spalte_ziel As Long

Dim str_register As String

Dim rng_fund As Range



Set obj_wkb_ziel = ThisWorkbook

Set obj_wks_ziel = obj_wkb_ziel.Worksheets("Zieldatei")   ' Blattname ggf. ändern



Set obj_wkb_quelle = Workbooks.Open("C:\Quelldatei.xlsx")  ' Pfad und Dateiname ggf. anpassen

Set obj_wks_quelle = obj_wkb_quelle.Worksheets("Quelldatei") ' Blattname ggf. anpassen



str_register = InputBox("Register eingeben")

lng_zeile_quelle = 2

lng_spalte_ziel = obj_wks_ziel.Cells(1, Columns.Count).End(xlToLeft).Column + 1

obj_wks_ziel.Cells(1, lng_spalte_ziel) = str_register



With obj_wks_quelle

    Do Until .Cells(lng_zeile_quelle, 3) = ""

        Set rng_fund = obj_wks_ziel.Columns(3).Find(.Cells(lng_zeile_quelle, 3), LookIn:=xlValues, lookat:=xlWhole)

        If Not rng_fund Is Nothing Then

            obj_wks_ziel.Cells(rng_fund.Row, lng_spalte_ziel) = .Cells(lng_zeile_quelle, 6)

        End If

        lng_zeile_quelle = lng_zeile_quelle + 1

    Loop

    obj_wkb_quelle.Close savechanges:=vbNo

End With





Set obj_wks_ziel = Nothing

Set obj_wks_quelle = Nothing



Set obj_wkb_quelle = Nothing

Set obj_wkb_ziel = Nothing

End Sub

Der Code gehört in ein Modul der Zieldatei. Der Code geht avon aus, dass die Quelldatei noch geöffnet werden muss. Pfad, dateiname und Blattnamen musst Du ggf. anpassen.

AW: Schleife von einem Register zu einem anderen

22.11.2024 20:39:55

Hans

Auch eine gute lösung und ja ist wirklich ein wenig leichter im Aufbau
Danke dir
Gruss Hans

AW: Schleife von einem Register zu einem anderen

22.11.2024 17:13:30

Hans

Hallo Regina
Vielen lieben Dank
Funktioniert einwandfrei
Gruss Hans

AW: Schleife von einem Register zu einem anderen

22.11.2024 18:46:56

Yal

Moin,

sorry, ich habe es mir mit den langen Variablennamen schwer getan.

Genau dieselbe Code wie Regina (also kein bisschen "besser" oder schneller), nur leichter (oder?)

Public Sub Uebertrag()

Dim wsQ As Worksheet

Dim NeueSpalte As Long

Dim Q As Range

Dim F As Range



'Ziel-Blatt

    With ThisWorkbook.Worksheets("Zieldatei")   ' Blattname ggf. ändern

    'Quelldatei & -blatt + Prüfung

        Set wsQ = Arbeitsblatt_öffnen("C:\Quelldatei.xlsx", "Quelldatei") ' Blattname ggf. anpassen

        If wsQ Is Nothing Then

            MsgBox "Datei ""C:\Quelldatei.xlsx""" & vbCr _

                & "oder darin enthaltene Blatt ""Quelldatei""" & vbCr & "nicht gefunden."

            Exit Sub

        End If

    'Abfrage

        NeueSpalte = .Cells(1, Columns.Count).End(xlToLeft).Column + 1

        .Cells(1, NeueSpalte) = InputBox("Register eingeben")

    'Durchlauf

        For Each Q In Range(wsQ.Cells(2, "C"), wsQ.Cells(Rows.Count, "C").End(xlUp))

            Set F = .Columns(3).Find(Q.Value, LookIn:=xlValues, lookat:=xlWhole)

            If Not F Is Nothing Then .Cells(F.Row, NeueSpalte) = Q.EntireRow.Range("G1")

        Next

        wsQ.Parent.Close savechanges:=vbNo

    End With

End Sub



Public Function Arbeitsblatt_öffnen(DateiName As String, BlattName As String) As Worksheet

    On Error Resume Next

    Set Arbeitsblatt_öffnen = Workbooks.Open(DateiName).Worksheets(BlattName)

End Function

VG
Yal

AW: Schleife von einem Register zu einem anderen

02.12.2024 16:26:18

Hans

Hallo liebe Gemeinde
Also habe erst jetzt bemerkt das der Code nicht so läuft wie ich mir das Vorgestellt habe.

Wenn ich bei register eingabe z.b A200 eingebe soll er das Register erstellen und die mengen einmal eintragen
Wenn ich aber z.b A300 eingebe darf er unter dem Register A300 nicht nochmals die mengen von Register A200 eintragen.

Denn Wenn ich so zum Testen register A300 eingebe und er keine Spalte in der Quelldatei mit A300 findet darf er nicht einfach das gefundene unter A200 eintragen.
Habe noch das Beispiel und die Quelldatei nochmals angehängt.

https://www.herber.de/bbs/user/173935.xlsm
https://www.herber.de/bbs/user/173937.xlsx

Gruss Hans

AW: Schleife von einem Register zu einem anderen

02.12.2024 21:53:49

ReginaR

Hi,

da bin ich wirklich etwas "zu kurz gesprungen". Teste mal diesen Code:





Public Sub Uebertrag()

Dim obj_wkb_ziel As Workbook

Dim obj_wkb_quelle As Workbook

Dim obj_wks_quelle As Worksheet

Dim obj_wks_ziel As Worksheet

Dim lng_zeile_quelle As Long

Dim lng_spalte_ziel As Long

Dim str_register As String

Dim rng_fund As Range



Set obj_wkb_ziel = ThisWorkbook

Set obj_wks_ziel = obj_wkb_ziel.Worksheets("Zieldatei")   ' Blattname ggf. ändern



Set obj_wkb_quelle = Workbooks.Open("C:\Regina\Quelldatei.xlsx")  ' Pfad und Dateiname ggf. anpassen

Set obj_wks_quelle = obj_wkb_quelle.Worksheets("Quelldatei") ' Blattname ggf. anpassen



str_register = InputBox("Register eingeben")

lng_zeile_quelle = 2

lng_spalte_ziel = obj_wks_ziel.Cells(1, Columns.Count).End(xlToLeft).Column + 1

obj_wks_ziel.Cells(1, lng_spalte_ziel) = str_register



With obj_wks_quelle

    Do Until .Cells(lng_zeile_quelle, 3) = ""

        Set rng_fund = obj_wks_ziel.Columns(3).Find(.Cells(lng_zeile_quelle, 3), LookIn:=xlValues, lookat:=xlWhole)

        If Not rng_fund Is Nothing And .Cells(rng_fund.Row, 1) = str_register Then

            obj_wks_ziel.Cells(rng_fund.Row, lng_spalte_ziel) = .Cells(lng_zeile_quelle, 6)

        End If

        lng_zeile_quelle = lng_zeile_quelle + 1

    Loop

    'obj_wkb_quelle.Close savechanges:=vbNo

End With





Set obj_wks_ziel = Nothing

Set obj_wks_quelle = Nothing



Set obj_wkb_quelle = Nothing

Set obj_wkb_ziel = Nothing

End Sub

AW: Schleife von einem Register zu einem anderen

03.12.2024 11:53:20

Hans

Hallo Regina
Der Piet hatt mich auch noch ein wenig Unterstützt.
Was bei dem Code nicht geht ist das er es in der Zieldatei die zugefügten A300 einfach unterhalb anhängt statt sie in der Zieldatei suchen geht.
Ich habe im Beispiel in der Spalte A300 mal die Menge eingetragen wie es aussehen sollte.
Vieleicht kanst du mir nochmals helfen, danke im Vorraus
LG Hans

https://www.herber.de/bbs/user/173951.xlsm

AW: Schleife von einem Register zu einem anderen

03.12.2024 16:03:23

ReginaR

... der Code in Deiner Datei stammt so nicht von mir, vielleicht schaut Piet da mal drüber ... ist ein ganz anderer Ansatz als bei mir

VG Regina

Schleife von einem Register zu einem anderen

Forumthread: Schleife von einem Register zu einem anderen

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Schleife von einem Register zu einem anderen

Forumthread: Schleife von einem Register zu einem anderen

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread