AW: Text in Array speichern und auslesen
07.10.2014 14:55:19
Daniel
hi
warum VBA, wenns mit zwei einfachen Formeln funktioniert?
zum Vergleich der benötigte VBA-Code
Sub test()
Dim arrM
Dim arrG
Dim arrX
Dim Erg
Dim z As Long
Dim s As Long
With Sheets("Tabelle1")
arrG = .Range(.Cells(4, 1), .Cells(4, 1).End(xlDown))
arrM = .Range(.Cells(2, 2), .Cells(2, 2).End(xlToRight))
arrX = .Range(.Cells(4, 2), .Cells(.Cells(4, 1).End(xlDown).Row, .Cells(2, 2).End(xlToRight) _
.Column))
ReDim Erg(1 To UBound(arrG, 1), 1 To 2)
End With
For z = 1 To UBound(arrG, 1)
For s = 1 To UBound(arrM, 2)
Erg(z, 1) = arrG(z, 1)
If arrX(z, s) = "x" Then
Erg(z, 2) = Erg(z, 2) & vbLf & arrM(1, s)
End If
Next
If Len(Erg(z, 2)) > 0 Then Erg(z, 2) = Mid$(Erg(z, 2), 2)
Next
Sheets("Tabelle2").Cells(2, 1).Resize(UBound(Erg, 1), 2).Value = Erg
End Sub
zum Vergleich nochmal der VBA-Code den du brauchst, um die Formel-Lösung zu realisieren:
Sub test2()
Sheets("Tabelle1").Cells.Copy Sheets("Tabelle3").Cells(1, 1)
With Sheets("Tabelle3")
With .Range(.Cells(4, 2), .Cells(.Cells(4, 1).End(xlDown).Row, .Cells(2, 2).End(xlToRight). _
Column))
.FormulaR1C1 = "=IF(Tabelle1!RC=""x"", Tabelle1!R2C,"""")&IF(RC[1]"""",CHAR(10),"""")& _
RC[1]"
End With
.Range(.Cells(4, 1), .Cells(4, 1).End(xlDown).Offset(0, 1)).Copy
Sheets("Tabelle2").Cells(2, 1).PasteSpecial xlPasteValues
End With
End Sub
braucht deutlich weniger Zeilen und ist vorallem dann viel angenehmer, wenn du den Code im Einzelstep testen musst.
Viel langsamer ist es wahrscheinlich auch nicht.
Gruß Daniel