Anzeige

Werte aus den Zellen gezielt wählen und schreiben lassen


#1
Ich versuche seit Tagen ein Problem zu lösen.
Scheint sehr einfach zu seien, aber kriege es einfach nicht hin. Kurz davor auszurasten. Also eine Hilfe wäre mir sehr sehr super..

Ich möchte die Excel-Datei, welche ich hochladen werden, in vba lesen lassen und gezielt nach Wunsch in externe Datei (csv/txt) schreiben lassen.

Wichtig hierbei sind hier die Spalten E und F.
Bsp.weise: in der Zeile 5-23 steht "Bild. Möchte, dass wenn immer "Bild" auftaucht, das letzte Bild(hierbei Zeile 23) aufgeschrieben und unter dieser "Bild" alle Einträge (Eintrag:...") geschrieben werden

Falls ich nicht so verständlich erklärt habe, schaut einfach die Excel-Datei an.

Tabelle 1: eingangswerte/ So siehst jetzt aus
Die letzten Bild-zeilen habe ich gelb markiert
Tabelle 2: So soll die externe Datei aussehen


Wenn Ihr mir helfen könnt, wäre es wirklich super...
 

Anhänge

Zuletzt bearbeitet:
#3
Guten Abend,

verstehe ich es richtig, dass Du alle "Bilder" und die dazugehörigen Felder darunter in Tabelle 2 schreiben möchtest?
nein. Ich möchte die Tabelle 1 lesen und in eine externe Datei , wie in Tabelle 2 aussieht", schreiben.
Und beim schreiben nicht alle Bilder schreiben sondern, letztes Bild schreiben dann die Einträge...
Das so oft wiederholen... bis endezeile
 

Yaslaw

n/a
Moderator
#4
Ist nicht so schwer

Erklärungen im Code
Visual Basic:
Public Sub t405709()
    Const C_SRC_TABLE = "Tabelle1"      'Name der Quelltabelle
    Const C_SRC_ADRESS = "A:G"          'zu kopierender Range
    Const C_TRG_TABLE = "trg"           'Name der Zieltabelle
    Const C_FILTER_COL = 5              'Spalte zum Filtern (E)
    Const C_FILTER_VALUE = "Bild"       'Wert zum filtern
   
   
    Dim srcWs As Worksheet:     Set srcWs = Worksheets(C_SRC_TABLE)
    Dim srcRng As Range:        Set srcRng = srcWs.Range(C_SRC_ADRESS)
    Dim trgWs As Worksheet:     Set trgWs = Worksheets(C_TRG_TABLE)
   
    Dim rowRng As Range
    Dim bildRow As Long
    Dim lastTrgRowNr As Long:   lastTrgRowNr = -1
    Dim blockFlag As Boolean
   
    'Bestehende Daten löschen
    trgWs.UsedRange.Clear
   
    'Zeilen durchiterieren
    For Each rowRng In srcRng.rows
        'Wenn die ganze Zeile leer ist, aufhören
        If srcWs.Application.WorksheetFunction.CountA(rowRng) = 0 Then Exit For
        'Bildfilter prüfen
        If rowRng.Cells(1, C_FILTER_COL).value = C_FILTER_VALUE Then
            blockFlag = False           'Block zurücksetzen
            bildRow = rowRng.row        'Letzte Bild-Zeile merken
        ElseIf bildRow > 1 Then
            'Falls Blockanfang, die letzte Bildzeile ausgeben
            If Not blockFlag Then
                lastTrgRowNr = lastTrgRowNr + 2     'Zielzeile ermitteln (inkl. einer Leerzeile am Anfang)
                'Letzte Bild-Zeile kopieren
                rowRng.Offset(-1).Copy trgWs.Cells(lastTrgRowNr, 1)
                lastTrgRowNr = lastTrgRowNr + 1     'Plus eine Leerzeile
            End If
            blockFlag = True                            'Block beginnen
            lastTrgRowNr = lastTrgRowNr + 1             'Zielzeile ermitteln
            rowRng.Copy trgWs.Cells(lastTrgRowNr, 1)    'Zeile kopieren
        End If
    Next rowRng
    'mitkopierte Formate entfernen
    trgWs.UsedRange.ClearFormats
End Sub
 

Yaslaw

n/a
Moderator
#6
Du musst die Konstante für dich anpassen. Bei mir ist es ein Sheet namens trg. Was ist es bei dir?
Visual Basic:
 Const C_TRG_TABLE = "trg"           'Name der Zieltabelle
 
#8
Das funktioniert einwandfrei!:)
Wie würdet ihr aus einer externen Datei "ungeöffnet" Werte entnehmen und diese mit oben erwähnten Bild-Zeilen vergleichen?
Ich finde nur Lösungswese, wo ich die externe Datei erst öffnen muss.
 

Yaslaw

n/a
Moderator
#9
Du kannst nicht aus einer ungeöffneten Datei Werte entnehmen. Mindestens im VBA musst du sie öffnen
Hier als Beispiel, dass die Quelle in einem anderen Workbook ist
Visual Basic:
    Dim srcWb As Excel.Workbook:    Set srcWb = Workbooks.Open("C:\MeineQuelle.xlsx")
    Dim srcWs As Worksheet:         Set srcWs = srcWb.Worksheets(C_SRC_TABLE)
    ...
    Set srcWs = Nothing
    srcWb.Close False   'Quelle Schliessen ohne speichern
 
#10
Du kannst nicht aus einer ungeöffneten Datei Werte entnehmen. Mindestens im VBA musst du sie öffnen
Hier als Beispiel, dass die Quelle in einem anderen Workbook ist
Visual Basic:
    Dim srcWb As Excel.Workbook:    Set srcWb = Workbooks.Open("C:\MeineQuelle.xlsx")
    Dim srcWs As Worksheet:         Set srcWs = srcWb.Worksheets(C_SRC_TABLE)
    ...
    Set srcWs = Nothing
    srcWb.Close False   'Quelle Schliessen ohne speichern
Verstehe.
Mit der "ExecuteExcel4Macro"-Anweisung funktionierts zwar, allerdings aber nicht so, wie ich es mir vorstelle.

Das Problem beim Öffnen der externen Datei ist, dass der Sortierungsteil, welche du in der Public Sub t405709() erklärt hast, Fehler anzeigt.
 
#12
Ist nicht so schwer

Erklärungen im Code
Visual Basic:
Public Sub t405709()
    Const C_SRC_TABLE = "Tabelle1"      'Name der Quelltabelle
    Const C_SRC_ADRESS = "A:G"          'zu kopierender Range
    Const C_TRG_TABLE = "trg"           'Name der Zieltabelle
    Const C_FILTER_COL = 5              'Spalte zum Filtern (E)
    Const C_FILTER_VALUE = "Bild"       'Wert zum filtern
 
 
    Dim srcWs As Worksheet:     Set srcWs = Worksheets(C_SRC_TABLE)
    Dim srcRng As Range:        Set srcRng = srcWs.Range(C_SRC_ADRESS)
    Dim trgWs As Worksheet:     Set trgWs = Worksheets(C_TRG_TABLE)
 
    Dim rowRng As Range
    Dim bildRow As Long
    Dim lastTrgRowNr As Long:   lastTrgRowNr = -1
    Dim blockFlag As Boolean
 
    'Bestehende Daten löschen
    trgWs.UsedRange.Clear
 
    'Zeilen durchiterieren
    For Each rowRng In srcRng.rows
        'Wenn die ganze Zeile leer ist, aufhören
        If srcWs.Application.WorksheetFunction.CountA(rowRng) = 0 Then Exit For
        'Bildfilter prüfen
        If rowRng.Cells(1, C_FILTER_COL).value = C_FILTER_VALUE Then
            blockFlag = False           'Block zurücksetzen
            bildRow = rowRng.row        'Letzte Bild-Zeile merken
        ElseIf bildRow > 1 Then
            'Falls Blockanfang, die letzte Bildzeile ausgeben
            If Not blockFlag Then
                lastTrgRowNr = lastTrgRowNr + 2     'Zielzeile ermitteln (inkl. einer Leerzeile am Anfang)
                'Letzte Bild-Zeile kopieren
                rowRng.Offset(-1).Copy trgWs.Cells(lastTrgRowNr, 1)
                lastTrgRowNr = lastTrgRowNr + 1     'Plus eine Leerzeile
            End If
            blockFlag = True                            'Block beginnen
            lastTrgRowNr = lastTrgRowNr + 1             'Zielzeile ermitteln
            rowRng.Copy trgWs.Cells(lastTrgRowNr, 1)    'Zeile kopieren
        End If
    Next rowRng
    'mitkopierte Formate entfernen
    trgWs.UsedRange.ClearFormats
End Sub
Hier der Bild-Sortierungscode
Und der Fehler ist hier: Dim srcWs As Worksheet: Set srcWs = Worksheets(C_SRC_TABLE)

Bevor ich so viel "laber" und das Gespräch ins Nichts bringe, schreibe ich was ich vor habe.
Wie oben zitiert, habe ich die Excel-Datei sortiert. In der sortierten Excel-Datei sind ja: in der ersten Zeile "Bild: Bildnummer"; in der nächsten Zeilen die Einträge aufgelistet.
Jetzt möchte ich aus einer externen Datei. Die Einträge spezialisieren. D.h.:

Veränderbare Werte:
interner Datei: Bild 14 --> Eintrag:Command --> Änderung 0 zu 1

Lokale Werte
externer Datei: Bild 14-->Eintrag:Command---> Lichteinschaltung---->1---->ON
externer Datei: Bild 14-->Eintrag:Command---> Lichteinschaltung---- >0---->OFF

Vergleich der internen mit externen und schreibe eine neue Datei/Tabelle.
Neue Datei sieht dann so aus:
Bild 14--->Lichteinschaltung ---> On

Danke im Voraus
 

Yaslaw

n/a
Moderator
#13
Das ist kein Sortierungscode. Das ist ein einfaches zuweisen eines Worksheets. Nix mit sortieren.

Und die Fehlermeldung ist?
Des Weiteren. In welcher Datei wird der Code ausgeführt? In der Zieldatei? In der Quelldatei? In einer dritten unabhängigen Datei?
 
#14
Das ist kein Sortierungscode. Das ist ein einfaches zuweisen eines Worksheets. Nix mit sortieren.

Und die Fehlermeldung ist?
Des Weiteren. In welcher Datei wird der Code ausgeführt? In der Zieldatei? In der Quelldatei? In einer dritten unabhängigen Datei?
- Runtime-Error.
- Code wird in der Zieldatei ausgeführt, wo meine "Rohdaten" sind. In der unabhängingen Datei (externen Datei) befinden sich die Spezifikationen.
 
#18
Ich weiss, ich frage zu viel. Und vieles davon ist sehr einfach. Ich bin erneut in einer Problematik verwickelt. Wenn ihr mir dieses löst oder Tipp gibt, werde ich euch nicht mehr nerven. Weil ich den Rest ohne Probleme erledigen kann... Also das letzte Mal....

Ich versuche es zu erläutern:

Kommentar #1 dieser Thread: Habe eine Datei hochgeladen und mein Problem geschildert.

Durch Kommentar #4 wurde mein Problem gelöst.
Ist nicht so schwer

Erklärungen im Code
Visual Basic:
Public Sub t405709()
    Const C_SRC_TABLE = "Tabelle1"      'Name der Quelltabelle
    Const C_SRC_ADRESS = "A:G"          'zu kopierender Range
    Const C_TRG_TABLE = "trg"           'Name der Zieltabelle
    Const C_FILTER_COL = 5              'Spalte zum Filtern (E)
    Const C_FILTER_VALUE = "Bild"       'Wert zum filtern
 
 
    Dim srcWs As Worksheet:     Set srcWs = Worksheets(C_SRC_TABLE)
    Dim srcRng As Range:        Set srcRng = srcWs.Range(C_SRC_ADRESS)
    Dim trgWs As Worksheet:     Set trgWs = Worksheets(C_TRG_TABLE)
 
    Dim rowRng As Range
    Dim bildRow As Long
    Dim lastTrgRowNr As Long:   lastTrgRowNr = -1
    Dim blockFlag As Boolean
 
    'Bestehende Daten löschen
    trgWs.UsedRange.Clear
 
    'Zeilen durchiterieren
    For Each rowRng In srcRng.rows
        'Wenn die ganze Zeile leer ist, aufhören
        If srcWs.Application.WorksheetFunction.CountA(rowRng) = 0 Then Exit For
        'Bildfilter prüfen
        If rowRng.Cells(1, C_FILTER_COL).value = C_FILTER_VALUE Then
            blockFlag = False           'Block zurücksetzen
            bildRow = rowRng.row        'Letzte Bild-Zeile merken
        ElseIf bildRow > 1 Then
            'Falls Blockanfang, die letzte Bildzeile ausgeben
            If Not blockFlag Then
                lastTrgRowNr = lastTrgRowNr + 2     'Zielzeile ermitteln (inkl. einer Leerzeile am Anfang)
                'Letzte Bild-Zeile kopieren
                rowRng.Offset(-1).Copy trgWs.Cells(lastTrgRowNr, 1)
                lastTrgRowNr = lastTrgRowNr + 1     'Plus eine Leerzeile
            End If
            blockFlag = True                            'Block beginnen
            lastTrgRowNr = lastTrgRowNr + 1             'Zielzeile ermitteln
            rowRng.Copy trgWs.Cells(lastTrgRowNr, 1)    'Zeile kopieren
        End If
    Next rowRng
    'mitkopierte Formate entfernen
    trgWs.UsedRange.ClearFormats
End Sub
Jetzt ist mein Anliegen folgendes:
Durch oben erwähnten Code wird in meiner Excel-Datei, gezielte Werte aus der Tabelle1 gefiltert und in der Tabelle2 ausgeschrieben.

Ich möchte nun die Werte aus der Quelltabelle durch die Werte der externen Datei( im Anhang) ersetzen.
D.h.:
In der Quelltabelle steht bsp.weise: Spalte F "Bildnummer", Eine Zeile tiefer: Spalte E "Eintrag:Value", Spalte F "Wertsänderung"

In der externen Tabelle stehen in der Spalte A "Bildnummer", Spalte C "Value" Spalte D"Umdrehung" Spalte F ".."

Also:
1) Vergleiche aus Quell- und extern Tabelle die Bildnr! Wenn sie gleich sind:
2) Vergleiche die Einträge der beiden Tabellen( Der Zellinhalt ist nicht 1 zu 1).

Wenn 1) und 2) stimmen, dann überschreibe die Spalte E aus der Quelltabelle mit Spalte D aus der Externen. Der Rest kann dann stehen bleiben!
 

Anhänge

Yaslaw

n/a
Moderator
#20
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.
 
Anzeige

Neue Beiträge

Anzeige