Retrieve data in two dimensional Object

Hallo,

leider weiß ich nicht, welches Add-In du meinst, ein MS Query Add-In kenne ich nicht.

Falls du das hier meinst, das gibt es in Excel 2013 auch noch und dafür ist kein Zusatz-Add-In erforderlich:

http://office.microsoft.com/de-de/excel-help/use-microsoft-query-to-retrieve-external-data-HA010099664.aspx

Microsoft Power Query und PoverPivot sind nur für die von mir in meiner ersten Antwort genannten Versionen verfügbar. Mit deinem Office 2013 Professional kannst du die Add-Ins nicht nutzen. Wenn du die Add-Ins benötigst, musst du dir eine Office Version
kaufen, die diese Add-Ins unterstützt.

Gruß,

Pauline

Hallo Desislava Dimova,

auch das hat leider nicht funktioniert. Ich bekomme folgende Fehlermeldung: "Unable to remove this Domain. Use Get-MsolUser -DomainName <domain name> to retrieve a list ob objects that are blocking removal."

Aber dieser Befehl liefert keine User zurück. Es gibt auch keine User mehr, die diese Domain verwenden.

Hast du noch eine Idee? Vielen Dank für Deine Hilfe.

Hello,

I distributed the objects and animations from the single, complex slide to 10 slides so that the new slides have only two objects with few animations. The MPEG4 video creation in Powerpoint completes now within one hour in Standard and Full HD resolution.

Regards,

Peter

Nicht nur die Tabstops sind ein Problem, auch die Zeilenumbrüche. Nimm ein Makro zum Einfügen.
<br />Andreas.
<br />Sub Test()
Dim Content As String
Content = GetClip
Content = Replace(Content, vbCrLf, vbLf)
Content = Replace(Content, vbTab, "")
ActiveCell.FormulaLocal = Trim$(Content)
End Sub

Private Function GetClip() As String
Dim MyData As Object, Data
Set MyData = CreateObject("htmlfile")
Data = MyData.ParentWindow.ClipboardData.GetData("text")
If Not IsNull(Data) Then GetClip = Data
End Function

<br />

Also führen viele Wege nach Rom wie man so sagt...

Was ich gezeigt habe

Data = WB.ActiveSheet.Range("A11:A15")

liest die Werte der Zellen immer in ein 2 dimensionales Array ein.

Das ist für Deinen Fall einfacher, weil die Daten ja noch transponiert werden sollen. Der Haken dabei ist jedoch das man immer nur einen zusammenhängenden Bereich einlesen kann.

Wenn Du mehrere Bereiche einlesen willst, dann könnte man das Array erweitern. Für Deinen Fall geht das recht einfach, weil das anschließende

Data = WorksheetFunction.Transpose(Data)

aus dem 2 dimensionalem Array ein 1 dimensionales Array macht.

Dazu nehme man diese Sub

Sub AppendArr(ByRef Dest, ByRef Source)

'Hängt Source an Dest an

Dim i As Long, j As Long

'Das Ende von Dest merken

j = UBound(Dest)

'Dest vergrößern

ReDim Preserve Dest(LBound(Dest) To UBound(Dest) + UBound(Source) - LBound(Source) + 1)

'Source kopieren

For i = LBound(Source) To UBound(Source)

j = j + 1

Dest(j) = Source(i)

Next

End Sub

Und ändere die Hauptroutine ein wenig ab.

With WorksheetFunction

'Daten lesen und von Zeilen in Spalten umwandeln

Data = .Transpose(WB.ActiveSheet.Range("A11:A15"))

'Nächsten Bereich

Temp = .Transpose(WB.ActiveSheet.Range("H13:H14"))

'Array zusammenhängen

AppendArr Data, Temp

End With

'Datei zu

WB.Close False

'Daten in Tabelle schreiben

i = i + 1

Cells(i, 1).Resize(1, UBound(Data)) = Data

Man kann das ganze aber auch mit Copy und PasteSpecial machen, das würde eher dem Makrorekorder entsprechen, der zeichnet ja sowas auf wenn man die Aktion von Hand ausführt.

Und eine Schleife für die Bereiche ist wohl einfacher zu handhaben (würde bei der Array-Variante auch gehen).

Bei den paar Zellen ist es letztenendes wurscht, bei vielen Daten ist die Array-Variante deutlich schneller.

Andreas.

Sub Test()

Dim WB As Workbook

Dim FName As String

Dim Area As Range, Dest As Range, Source As Range

Dim i As Long

'Suche erste Datei

FName = Dir(ThisWorkbook.Path & "\*.xls")

'Datei gefunden?

Do While FName <> ""

'Ist es diese Datei?

If FName = ThisWorkbook.Name Then GoTo NextFile

'Datei öffnen

Set WB = Workbooks.Open(ThisWorkbook.Path & "\" & FName)

'Quellbereich definieren

Set Source = WB.ActiveSheet.Range("A11:A15, H13:H14, L19")

'Ziel definieren

i = i + 1

Set Dest = ThisWorkbook.ActiveSheet.Cells(i, 1)

'Alle Bereiche durchlaufen

For Each Area In Source.Areas

'Breich kopieren

Area.Copy

'Einfügen

Dest.PasteSpecial xlPasteValues, Transpose:=True

'Ziel weitersetzen

Set Dest = Dest.Offset(0, Area.Rows.Count)

Next

'Datei zu

WB.Close False

NextFile:

'Suche nächste Datei

FName = Dir

Loop

'Kopiermodus aus

Application.CutCopyMode = False

End Sub