Werte aus den Zellen gezielt wählen und schreiben lassen

theva

Mitglied
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

  • Mappe1 (1).xlsx
    10,8 KB · Aufrufe: 11
Zuletzt bearbeitet:
Guten Abend,

verstehe ich es richtig, dass Du alle "Bilder" und die dazugehörigen Felder darunter in Tabelle 2 schreiben möchtest?
 
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
 
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
 
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
 
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.
 
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
 
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.
 
Zurück