Werte aus den Zellen gezielt wählen und schreiben lassen

Yaslaw hat gesagt.:
Irgendwie komme ich nicht mit was da wie und wo ersetzt werden soll.
Soll jetzt am Ziel noch irgendwie anhand der skurrilen weiteren Date noch irgendwas gemacht werden?
Sorry, ich weiss auch nicht mehr was mein Code eigentlich macht, da ich bereits so viele Codes auf einzelanfragen geleifert habe und keinen Schimmer habe, wie das zusammenspielen soll.
Zum Vergrößern anklicken....
Ok, kurz zusammengefasst:
Ich habe zwei Excel-Dateien. In der ersten befinden sich zwei Tabellen. In der zweiten eine Tabelle.

Datei 1(Quelldatei)
Tabelle 1: Roh-Werte
Tabelle 2: Gefiltert und übersicht verschaffene Werte aus der Tabelle 1

Datei 2(Extern)
Tabelle 3: Extern: Info-Datei

Durch dein Code wird in der ersten Excel-Datei eine Quelltabelle(1) gelesen/gefiltert und in eine andere Tabelle(2) geschrieben.
So filtere ich bestimmte Sachen und verschaffe Überblick.

Jetzt soll aus einer externen Excel Datei-Tabelle(3) Werte entnommen werden mit den Werten der Tabelle(2) verglichen werden und falls die Bedingungen stimmen, sollen die Werte der Tabelle(2) mit neuen Werten aus Tabelle(3) überschrieben werden.

Bedingungen sind (Vergleich der Tabelle 2-3): Stimmen die Bild-Nr? Wenn ja, dann stimmen die Einträge? Wenn ja, dann nehme Zellinhalt von .... und ersetzte es in der Tabelle 2 der Quelldatei.
 
Also. Vergessen wir mal den Schritt von (1) - >(2). Jetzt geht es um das abändern der Daten in (2) anhand von (3).
Lade doch bitte ein Excelsheet hoch mit Beispieldaten von (2). Und dann erkläre nochmals ganz genau die Logik, wie die Daten von (3) da einflissen. Nicht einfach "dann nimm die Werte" sondern Wenn Spalte Tabelle2.A mit Tabelle3.A übereinstimmt, dann ersetze Tabelle2.X durch Tabelle3.Y.
 
Ok.
1) Wenn die Spalte "F" aus der Quelldatei/Tabelle2 mit der Spalte "A" der externen Datei/Tabelle3 übereinstimmt, dann überprüfe:
2) Wenn die Spalte "E" aus der Quelldatei/Tabelle2 mit der Spalte "C" der externen Datei/ Tabelle3 (Hierbei sind die Zellinhalte nicht 1 zu 1 gleich, aber Befehle sind gleich) übereinstimmt, dann:

3) Ersetze Spalte"D" der externen Datei/ Tabelle3 in die Spalte "E" der Quelldatei/Tabelle2. Sowie Spalte "F" der externen Datei/ Tabelle3 in die Spalte "G" in die Quelldatei
 

Anhänge

Hm. 1) Das ist nur bei Bild-Zeilen. der Fall.
Dann ist aber für 2) Die Spalte C "Bild" und das findet sich in der externen Tabelle nicht.
 
Yaslaw hat gesagt.:
Hm. 1) Das ist nur bei Bild-Zeilen. der Fall.
Dann ist aber für 2) Die Spalte C "Bild" und das findet sich in der externen Tabelle nicht.
Zum Vergrößern anklicken....
In der Spalte F.Tabelle2 sind ja Bildnr. hinterlegt. sowie Spalte A.Tabelle3. Wenn die übereinstimmen, soll in der Quelldatei sowie in der externen Datei eine Schleife durchgeführt mit einander verglichen werden. Abbruchskriterium= leere Zeile

Und die Übereinstimmungen unter selben Bild.Nr. sollen überschrieben werden.
 
Jetzt wird's Lustig. Ich löse das mittels Dictionaries und RegExp.
Viel Spass beim Versuch es zu verstehen.....
Visual Basic: 
Option Explicit

Public Sub t405709()
    Dim ws As Worksheet:        Set ws = ActiveWorkbook.Worksheets("Tabelle2")
    Dim wbExtern As Workbook:   Set wbExtern = Workbooks.Open("C:\_TMP\ForumSandbox\t405709\extern.xlsx", , True)
    Dim wsExtern As Worksheet:  Set wsExtern = wbExtern.Worksheets("Sheet1")
    
    Dim rowNr As Long
    Dim keyNr As Long
    Dim rx As Object
    Dim eintrag As String
    
    'Resultate aufbauen:
'        <Dictionary>  (
'            [127] => <Dictionary>  (
'                [COMMAND] => <Dictionary>  (
'                    [E] => <String> 'Licht eingeschaltet'
'                    [F] => <String> 'W'
'                )
'                [VALUE] => <Dictionary>  (
'                    [E] => <String> 'Umdrehung'
'                    [F] => <String> 'U/Um'
'                )
'            )
'            [130] => <Dictionary>  (
'                [COMMAND] => <Dictionary>  (
'                    [E] => <String> 'Licht ausgeschaltet'
'                    [F] => <String> 'W'
'                )
'                [VALUE] => <Dictionary>  (
'                    [E] => <String> 'Umdrehung'
'                    [F] => <String> 'U/Um'
'                )
'            )
'        )
    
    Dim keys As Object: Set keys = CreateObject("scripting.Dictionary")
    For rowNr = 1 To wsExtern.Cells.SpecialCells(xlCellTypeLastCell).Row
        If IsNumeric(wsExtern.Cells(rowNr, 1).Value) And Not IsEmpty(wsExtern.Cells(rowNr, 1).Value) Then
            keyNr = wsExtern.Cells(rowNr, 1).Value
            eintrag = UCase(Trim(wsExtern.Cells(rowNr, 3)))
            If Not keys.exists(keyNr) Then keys.add keyNr, CreateObject("scripting.Dictionary")
            If Not keys(keyNr).exists(eintrag) Then
                keys(keyNr).add eintrag, CreateObject("scripting.Dictionary")
                keys(keyNr)(eintrag).add "E", wsExtern.Cells(rowNr, 4).Value
                keys(keyNr)(eintrag).add "F", wsExtern.Cells(rowNr, 6).Value
            End If
        End If
    Next rowNr
    wbExtern.Close False
    D keys

    'RegEx aufbauen um die Eintragszeile zu zerlegen
    Set rx = CreateObject("VBScript.RegExp")
    rx.pattern = "^Eintrag:\s*(.*?)\s*$"

    'Zeilenweise durchgehen
    For rowNr = 1 To ws.Cells.SpecialCells(xlCellTypeLastCell).Row
        If WorksheetFunction.CountA(ws.rows(rowNr)) <> 0 Then
            'Wenn es ein Bild ist, die Nummer merken
            If ws.Cells(rowNr, 5).Value = "Bild" Then keyNr = ws.Cells(rowNr, 6)
            'Bei einem Eintrag den Command extrahieren
            If rx.test(ws.Cells(rowNr, 5).Value) Then
                'Eintrag extrahieren
                eintrag = UCase(rx.execute(ws.Cells(rowNr, 5).Value)(0).subMatches(0))
                'Prüfen ob die BildNr im Index exisitiert
                If keys.exists(keyNr) Then
                    'Prüfen ob zur BildNr der Eintrag im Index existiert
                    If keys(keyNr).exists(eintrag) Then
                        'Werte auslesen und zuweisen
                        ws.Cells(rowNr, 7).Value = keys(keyNr)(eintrag)("E")
                        ws.Cells(rowNr, 8).Value = keys(keyNr)(eintrag)("F")
                    End If
                End If
            End If
        End If
    Next rowNr
    
End Sub
 
Um antworten zu können musst du eingeloggt sein.

Neue Beiträge

Zurück