Merge unmerge werte übernehmen in leere zellen

So,
hallo an alle hier im Forum!
Folgendes problem wo ich einfach mal hoffe hier einen Lösungsansatz zu bekommen da google mit meinen Suchbegriffen nichts mehr hergibt ausser dieses Forum ;)
Ich habe eine Tabelle:
Zeile A steht die Artikelnummer, Zeile B die Farbe
Es gibt aber Artikel mit der selben Artikelnummer aber einer anderen Farbe, dann sieht das in etwa so aus:
CB9987 - Grün
------------ - Blau
-------------- Braun
CB9989 - Gelb
CB6677 - Lila
CB9984 - Grün
---------- - Blau
---------- - Braun
Die Zellen in A sind dann gemerged. Ich muss aber aus dem sheet welce 1800 zeilen hat jeden morgen eine CSV machen um die bestände abzugleichen.
Ich bräuchte also irgendein Macro welches mir nach dem unmergen die leeren felder mit dem dadrüber zugehörigem auffüllt!
Ein bisschen vba bekomme ich wohl noch hin, also mir würde zur not ein Lösungsansatz reichen da mir imo gar nichts einfällt!
Ich danke schonmal fürs Lesen
byebye
der Glen der Viddich

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

"1CB0-15",12,"BLACK",44,"Resim" ,33,"GRAY",6,"Resim" ,95,"WHITE",1,"Resim" "1CB0-2",12,"BLACK",203,"Resim" ,95,"WHITE",119,"Resim" "C-0011",78,"STANDARD",12,"Resim" "C-0012",,,1,"Resim" "C-0013",,,10,"Resim" "C-0014",,,4,"Resim" "C-0015",,,27,"Resim"

"1CB0-15",12,"BLACK",44,"Resim" "1CB0-15",33,"GRAY",6,"Resim" "1CB0-15",95,"WHITE",1,"Resim" "1CB0-2",12,"BLACK",203,"Resim" "1CB0-2",95,"WHITE",119,"Resim" "C-0011",78,"STANDARD",12,"Resim" "C-0012",,,1,"Resim" "C-0013",,,10,"Resim" "C-0014",,,4,"Resim" "C-0015",,,27,"Resim"

Sub Makro1() Dim lRow As Long lRow = Range("E65536").End(xlUp).Row Columns("A:A").MergeCells = False Range("F1").FormulaR1C1 = "=RC[-5]" Range("F2:F" & lRow).FormulaR1C1 = "=IF(RC[-5]="""",R[-1]C,RC[-5])" Range("A1:A" & lRow).Value = Range("F1:F" & lRow).Value Range("F1").EntireColumn.ClearContents End Sub

Hallo,
kannst ja mal testen ob es so geht.

Option Explicit

Sub test()
Dim meAr(), A&, B&, MerkWert
Dim F%, sFileName$, sLine$

sFileName$ = Application.GetSaveAsFilename("MeineCSV.csv", "CSV-Datei (*.csv), *.csv")

If sFileName$ = CStr(False) Then Exit Sub

If Dir(sFileName, vbNormal) <> "" Then
    If MsgBox("Datei schon vorhanden, soll diese ersetzt werden?" & vbCr & _
      "Wird die Datei nicht ersetzt, werden die Zeilen dazugeschrieben", vbQuestion + vbYesNo) = vbYes Then
        Kill sFileName
    End If
End If

meAr = Range("A1", Cells(Rows.Count, 5).End(xlUp)).Resize(, 5).Value2

For B = 1 To Ubound(meAr, 2)
    For A = 1 To Ubound(meAr)
        If meAr(A, B) <> "" Then MerkWert = meAr(A, B)
        If IsNumeric(MerkWert) Then
            meAr(A, B) = MerkWert
        Else
            meAr(A, B) = """" & MerkWert & """"
        End If
    Next A
Next B



F = FreeFile
Open sFileName For Append As #F

For A = 1 To Ubound(meAr)
    For B = 1 To Ubound(meAr, 2) - 1
        sLine$ = sLine$ & meAr(A, B) & ","
    Next B
    sLine = sLine & meAr(A, Ubound(meAr, 2))
    
    Print #F, sLine
    
    sLine$ = ""
Next A

Close #F


End Sub

Gruß Tino

Beliebteste Forumthreads (12 Monate)

Merge unmerge werte übernehmen in leere zellen

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

314 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Merge unmerge werte übernehmen in leere zellen

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

314 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread