[Makro] Spalte in einem Array speichern

MariaM · 10. November 2019 um 01:22

Hallo,

ich habe folgendes Problem, vielleicht kann mir jemand dabei helfen, denn ich verfüge nur über Grundkenntnisse in VBA. Und zwar:

Ich habe eine Excel-Datei, die drei Worksheets enthält. Das erste Worksheet heißt „Produktgruppen“ und enthält zwei Spalten:

A | B
Produktgruppen-ID | Produktgruppen-Name
z.B. 12 | z.B. Produktgruppe 1
z.B. 124 | z.B. Produktgruppe 2

Die Spalte B möchte ich in einem Array speichern. Dieses möchte ich dann in einer Schleife durchlaufen und daraus Textdateien erstellen. Die Dateien sollen dann heißen, wie die Zellen z.B. Produkt 1.

Dann habe ich noch ein Worksheet, dieses heißt „Produkte“ und enthält ebenfalls zwei Spalten:

Und das letzte Worksheet heißt „Produkt-Eigenschaften“ und enthält vier Spalten:

A | B C D
Produkt-ID Produktname Farbe Typ
z.B. 11
z.B. 12
z.B. 13
z.B. 21

Ich möchte, dass die Produkte mit dazugehörigen Eigenschaften (Name, Farbe, Typ) in den richtigen Produktgruppen-Textdateien gespeichert werden. Also Produkt-Ids 11,12 und 13 im Textfile „Produktgruppe 1“ und Produkt-ID 21 im Textfile „Produktgruppe 2“.

Ich vermute, dass ich für das Makro zweidimensionale Arrays benötige. Ich weiß aber leider nicht, wie ich die Spalten in Arrays speichern kann. Vor Allem, wie kann ich nur ausgefüllte Zeilen speichern?

Ich wäre für jede Hilfe und andere Hinweise sehr dankbar.

Viele Grüße,
eure Maria

Reinhard_fb8cb7 · 10. November 2019 um 01:23

Ich habe eine Excel-Datei, die drei Worksheets enthält. Das
erste Worksheet heißt „Produktgruppen“ und enthält zwei
Spalten:
Die Spalte B möchte ich in einem Array speichern. Dieses
möchte ich dann in einer Schleife durchlaufen und daraus
Textdateien erstellen. Die Dateien sollen dann heißen, wie die
Zellen z.B. Produkt 1.

Hi Maria,
erstelle dir ein Verzeichnis c:\Test und probier mal den Code, ist das als Ansatz schon mal so wie du dir das vorstellst?:

Option Explicit

Sub tt()
Dim SpalteB As Variant, Zei As Long
With Worksheets("Produktgruppen")
 SpalteB = .Range("B1:B" & .Cells(Rows.Count, 2).End(xlUp).Row)
 For Zei = 1 To UBound(SpalteB)
 If SpalteB(Zei, 1) "" Then
 Open "C:\Test\" & SpalteB(Zei, 1) & ".txt" For Output As #1
 Print #1, "Ich bin Datei " & SpalteB(Zei, 1)
 Close #1
 End If
 Next Zei
End With
End Sub

Gruß
Reinhard

MariaM · 10. November 2019 um 01:23

Hi Maria,
erstelle dir ein Verzeichnis c:\Test und probier mal den Code,
ist das als Ansatz schon mal so wie du dir das vorstellst?:

Hallo Reinhard,

erst einmal vielen Dank für deine Hilfe. Der Ansatz ist genauso wie ich es mir gedacht habe. Wie kann ich eigentlich die verschiedenen IDs miteinander verknüpfen, so dass auch das Richtige in die Dateien reingeschrieben wird? Benötige ich dazu Arrays?

Ich wäre dir für jede weitere Hilfe sehr dankbar.

Liebe Grüße,
Maria

Reinhard_fb8cb7 · 10. November 2019 um 01:23

erst einmal vielen Dank für deine Hilfe. Der Ansatz ist
genauso wie ich es mir gedacht habe. Wie kann ich eigentlich
die verschiedenen IDs miteinander verknüpfen, so dass auch das
Richtige in die Dateien reingeschrieben wird?

Hi Maria,

Benötige ich dazu Arrays?

k.A.
Ich schaue mir die Problematik heute Abend oder Morgen mal an und versuche dann dir eine Lösung zu präsentieren.

Ob ich darin Arrays verwende oder nicht weiß ich jetzt noch nicht und ob ich meinen Ausgangscode benutze auch nicht.

Gruß
Reinhard

MariaM · 10. November 2019 um 01:24

Hallo Reinhard,

Ich schaue mir die Problematik heute Abend oder Morgen mal an
und versuche dann dir eine Lösung zu präsentieren.

Ich bin dir schon im Voraus dankbar.

Viele Grüße,
Maria

Reinhard_fb8cb7 · 10. November 2019 um 01:24

Ich habe eine Excel-Datei, die drei Worksheets enthält. Das
erste Worksheet heißt „Produktgruppen“ und enthält zwei
Spalten:
A | B
Produktgruppen-ID | Produktgruppen-Name
z.B. 12 | z.B. Produktgruppe 1
z.B. 124 | z.B. Produktgruppe 2

daraus
Textdateien erstellen. Die Dateien sollen dann heißen, wie die
Zellen z.B. Produkt 1.

Dann habe ich noch ein Worksheet, dieses heißt „Produkte“ und
enthält ebenfalls zwei Spalten:

A | B
Produktgruppen-ID | Produkt-ID
z.B. 12 | z.B. 11
z.B. 12 | z.B. 12
z.B. 12 | z.B. 13
z.B. 124 | z.B. 21

Und das letzte Worksheet heißt „Produkt-Eigenschaften“ und
enthält vier Spalten:

A | B C D
Produkt-ID Produktname Farbe Typ
z.B. 11
z.B. 12
z.B. 13
z.B. 21

Ich möchte, dass die Produkte mit dazugehörigen Eigenschaften
(Name, Farbe, Typ) in den richtigen Produktgruppen-Textdateien
gespeichert werden. Also Produkt-Ids 11,12 und 13 im Textfile
„Produktgruppe 1“ und Produkt-ID 21 im Textfile „Produktgruppe
2“.

Hi Maria,

in Modul1, ggfs mit Einfügen Modul anlegen.

Option Explicit

Sub tt()
Dim Zei1 As Long, Zei2 As Long, Zei3 As Long, Satz As String, S As Integer
Dim ws2 As Worksheet, ws3 As Worksheet, Meldung As String, Eingabe
Set ws2 = Worksheets("Produkte")
Set ws3 = Worksheets("Eigenschaften")
Application.ScreenUpdating = False
With Worksheets("Produktgruppen")
 For Zei1 = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
 Eingabe = 1
 If .Cells(Zei1, 2) "" Then
 If Dir("C:\Test\KK\" & .Cells(Zei1, 2) & ".txt") "" Then
 Meldung = "Die Datei:" & Chr(10) & Chr(10)
 Meldung = Meldung & "C:\Test\KK\" & .Cells(Zei1, 2) & ".txt" & Chr(10) & Chr(10)
 Meldung = Meldung & "existiert bereits, soll sie überschrieben werden?"
 Eingabe = MsgBox(Meldung, 35, "Warnung")
 End If
 If Eingabe = 1 Then
 Open "C:\Test\KK\" & .Cells(Zei1, 2) & ".txt" For Output As #1
 Print #1, "P-ID:stuck\_out\_tongue\_winking\_eye:-Name;Farbe;Typ"
 For Zei2 = 2 To ws2.Cells(Rows.Count, 2).End(xlUp).Row
 If ws2.Cells(Zei2, 1) = .Cells(Zei1, 1) Then
 For Zei3 = 2 To ws3.Cells(Rows.Count, 2).End(xlUp).Row
 If ws3.Cells(Zei3, 1) = ws2.Cells(Zei2, 2) Then
 Satz = ws3.Cells(Zei3, 4)
 For S = 3 To 1 Step -1
 Satz = ws3.Cells(Zei3, S) & ";" & Satz
 Next S
 Print #1, Satz
 End If
 Next Zei3
 End If
 Next Zei2
 Close #1
 End If
 End If
 Next Zei1
End With
Application.ScreenUpdating = True
End Sub

Gruß
Reinhard

MariaM · 10. November 2019 um 01:26

Hallo Reinhard,

vielen Dank für deine Mühe. Der Code macht genau das, was ich mir vorgestellt habe. Jetzt versuche ich das Ganze zu verstehen .

Liebe Grüße,
Maria

MariaM · 10. November 2019 um 01:28

Hallo Reinhard,

ich habe doch noch eine Frage. Ist es überhaupt möglich, das Modul in einer leeren Excel-Datei zu speichern. Von dort aus eine zu bearbeitende Excel-Datei, mit dem u.g. Code, auswählen und dann das Makro ausführen? Wäre für einen Hinweis sehr dankbar.

Public Sub FileOpen()
 Dim NameZiel As Variant, Nr As Integer
 NameZiel = Application.GetOpenFilename("Excel-Dateien (\*.xl\*),\*.xl\*", , "Please choose an Excel-File", MultiSelect:=True)
 If IsArray(NameZiel) Then
 For Nr = LBound(NameZiel) To UBound(NameZiel)
 If InStr(1, Right(NameZiel(Nr), 4), ".xl", 1) = 1 Then Workbooks.Open NameZiel(Nr)
 Next Nr
 ElseIf NameZiel = False Then Exit Sub
 ElseIf InStr(1, Right(NameZiel(Nr), 4), ".xl", 1) = 1 Then Workbooks.Open NameZiel(Nr)
 End If
End Sub

Liebe Grüße,
Maria

Reinhard_fb8cb7 · 10. November 2019 um 01:28

ich habe doch noch eine Frage. Ist es überhaupt möglich, das
Modul in einer leeren Excel-Datei zu speichern. Von dort aus
eine zu bearbeitende Excel-Datei, mit dem u.g. Code, auswählen
und dann das Makro ausführen? Wäre für einen Hinweis sehr
dankbar.

Hi Maria,

ungetestet, und es ist noch zu prüfen ob man in den Namen der
erzeugten Textdatei den Namen von „Mappe“ miteinbaut, oder
grundsätzlich nicht „Output“ benutzt, um Datensätze an eine schon
bestehende Textdatei anhängt. Ich glaub man nimmt dann Append o.ä.

Aber das liegt ja an deinen Wünschen.

Option Explicit

Public Sub FileOpen()
Dim NameZiel As Variant, Nr As Integer
NameZiel = Application.GetOpenFilename("Excel-Dateien (\*.xl\*),\*.xl\*", , "Please choose an Excel-File", MultiSelect:=True)
If TypeName(NameZiel) = "Boolean" Then Exit Sub
For Nr = LBound(NameZiel) To UBound(NameZiel)
 If Right(NameZiel(Nr), 4) Like ".xl\*" Then Workbooks.Open NameZiel(Nr)
 Call tt(ActiveWorkbook)
 ActiveWorkbook.Close savechanges:=False
Next Nr
End Sub


Sub tt(ByVal Mappe As Workbook)
Dim Zei1 As Long, Zei2 As Long, Zei3 As Long, Satz As String, S As Integer
Dim ws2 As Worksheet, ws3 As Worksheet, Meldung As String, Eingabe
Set ws2 = Mappe.Worksheets("Produkte")
Set ws3 = Mappe.Worksheets("Eigenschaften")
Application.ScreenUpdating = False
With Mappe.Worksheets("Produktgruppen")
For Zei1 = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
 Eingabe = 1
 If .Cells(Zei1, 2) "" Then
 If Dir("C:\Test\KK\" & .Cells(Zei1, 2) & ".txt") "" Then
 Meldung = "Die Datei:" & Chr(10) & Chr(10)
 Meldung = Meldung & "C:\Test\KK\" & .Cells(Zei1, 2) & ".txt" & Chr(10) & Chr(10)
 Meldung = Meldung & "existiert bereits, soll sie überschrieben werden?"
 Eingabe = MsgBox(Meldung, 35, "Warnung")
 End If
 If Eingabe = 1 Then
 Open "C:\Test\KK\" & .Cells(Zei1, 2) & ".txt" For Output As #1
 Print #1, "P-ID:stuck\_out\_tongue\_winking\_eye:-Name;Farbe;Typ"
 For Zei2 = 2 To ws2.Cells(Rows.Count, 2).End(xlUp).Row
 If ws2.Cells(Zei2, 1) = .Cells(Zei1, 1) Then
 For Zei3 = 2 To ws3.Cells(Rows.Count, 2).End(xlUp).Row
 If ws3.Cells(Zei3, 1) = ws2.Cells(Zei2, 2) Then
 Satz = ws3.Cells(Zei3, 4)
 For S = 3 To 1 Step -1
 Satz = ws3.Cells(Zei3, S) & ";" & Satz
 Next S
 Print #1, Satz
 End If
 Next Zei3
 End If
 Next Zei2
 Close #1
 End If
 End If
 Next Zei1
End With
 Application.ScreenUpdating = True
End Sub

Gruß
Reinhard