Bereich einer geschlossenen Excel-Tabelle in Array

Dim ARR_Import(1000, 1000) As String Private Sub CommandButton3_Click() Bereich_auslesen Test3 End Sub Private Sub Test3() 'Declaration Dim Arr_Data(1000, 130) Dim ix As Integer 'Columns Dim iy As Integer 'Rows 'ARR_Import = Sheets("Tabelle7").Range("A1:DZ1000").Value For ix = 1 To 130 'Spalte A bis DZ = 130 Spalten For iy = 1 To UBound(ARR_Import) If ARR_Import(iy, ix) = "Distribution Channel" Then Arr_Data(iy, 1) = "Distribution Channel" Arr_Data(iy, 2) = ARR_Import(iy + 1, ix) End If Next iy For iy = 1 To UBound(ARR_Import) If ARR_Import(iy, ix) = "Unit of Order Quantity" Then Arr_Data(iy + 1, 1) = "Unit of Order Quantity" Arr_Data(iy + 1, 2) = ARR_Import(iy + 1, ix) End If Next iy For iy = 1 To UBound(ARR_Import) If ARR_Import(iy, ix) = "Order" Then Arr_Data(iy + 2, 1) = "OrderNumber" Arr_Data(iy + 2, 2) = ARR_Import(iy + 1, ix) End If Next iy For iy = 1 To UBound(ARR_Import) If ARR_Import(iy, ix) = "ProjectManager" Then Arr_Data(iy + 3, 1) = "PM" Arr_Data(iy + 3, 2) = ARR_Import(iy + 1, ix) End If Next iy Next ix MsgBox _ Arr_Data(1, 1) & ": " & Arr_Data(1, 2) & vbNewLine & _ Arr_Data(2, 1) & ": " & Arr_Data(2, 2) & vbNewLine & _ Arr_Data(3, 1) & ": " & Arr_Data(3, 2) & vbNewLine & _ Arr_Data(4, 1) & ": " & Arr_Data(4, 2) End Sub Sub Bereich_auslesen() '** Dimensionierung der Variablen Dim pfad As String, datei As String, blatt As String, bereich As Range, zelle As Object '** Angaben zur auszulesenden Zelle pfad = "C:\Users\15_SAPExport" datei = "Export_Sample.xlsx" blatt = "Format" Set bereich = Range("A1:DM30") '** Bereich auslesen For Each zelle In bereich '** Zellen umwandeln zelle = zelle.Address(False, False) '** Eintragen in Bereich ARR_Import(zelle.Row, zelle.Column) = GetValue(pfad, datei, blatt, zelle) Next zelle MsgBox ARR_Import(3, 1) End Sub Private Function GetValue(pfad, datei, blatt, zelle) Dim arg As String If Right(pfad, 1) > "\" Then pfad = pfad & "\" If Dir(pfad & datei) = "" Then GetValue = "datei Not Found" Exit Function End If arg = "'" & pfad & "[" & datei & "]" & blatt & "'!" & Range(zelle).Range("A1").Address(, , xlR1C1) GetValue = ExecuteExcel4Macro(arg) End Function

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Dim ARR_Import(1000, 1000) As String Private Sub CommandButton1_Click() HoleDaten End Sub Public Function GetDataClosedWB(SourcePath As String, SourceFile As String, sourceSheet As String, SourceRange As String, TargetRange As Range) As Boolean Dim strQuelle As String Dim Zeilen As Long Dim Spalten As Byte On Error GoTo InvalidInput strQuelle = "'" & SourcePath & "[" & SourceFile & "]" & sourceSheet & "'!" & Range(SourceRange).Cells(1, 1).Address(0, 0) Zeilen = Range(SourceRange).Rows.Count Spalten = Range(SourceRange).Columns.Count With TargetRange.Cells(1, 1).Resize(Zeilen, Spalten) .Formula = "=IF(" & strQuelle & "="""",""""," & strQuelle & ")" .Value = .Value End With GetDataClosedWB = True Exit Function InvalidInput: MsgBox "Die Quelldatei oder der Quellbereich ist ungültig!", vbExclamation, "Get data from closed Workbook" GetDataClosedWB = False End Function Public Sub HoleDaten() Dim Pfad As String Dim Dateiname As String Dim Blatt As String Dim Bereich As String Dim Ziel As Range Pfad = "C:\Users\15_SAPExport\" Dateiname = "Export_Sample.xlsx" Blatt = "Format" Bereich = "A1:C20" Set Ziel = ActiveSheet.Range("A1") 'MsgBox Ziel If GetDataClosedWB(Pfad, Dateiname, Blatt, Bereich, Ziel) Then MsgBox "Daten importiert" End If End Sub

Application.ScreenUpdating = false With Workbooks.Open("pfad\dateiname", ReadOnly:=True) ARR_Import = .Sheets("Tabelle7").Range("A1:DZ1000").Value .Close False End with Application.ScreenUpdating = true

Guten Morgen zusammen,

anbei mein aktueller Stand.



Option Explicit



Dim ARR_Import() As String

Dim ARR_Data(1000, 1000) As String



Private Sub CommandButton1_Click()

HoleDaten

End Sub



Public Function GetDataClosedWB(SourcePath As String, SourceFile As String, sourceSheet As String, SourceRange As String, TargetRange As Range) As Boolean

Dim strQuelle As String

Dim Zeilen As Long

Dim Spalten As Byte

Dim ix As Integer       'Columns

Dim iy As Integer       'Rows



Dim ixx As Integer       'Columns

Dim iyy As Integer       'Rows



On Error GoTo InvalidInput



strQuelle = "'" & SourcePath & "[" & SourceFile & "]" & sourceSheet & "'!" & Range(SourceRange).Cells(1, 1).Address(0, 0)

Zeilen = Range(SourceRange).Rows.Count

Spalten = Range(SourceRange).Columns.Count



With TargetRange.Cells(1, 1).Resize(Zeilen, Spalten)

.Formula = "=IF(" & strQuelle & "="""",""""," & strQuelle & ")"

'.Value = .Value

End With



ReDim ARR_Import(Zeilen, Spalten)



For ix = 1 To Spalten

    For iy = 1 To Zeilen

        ARR_Import(iy, ix) = TargetRange.Cells(iy, ix) '.Value

    Next iy

Next ix



For ixx = 1 To Spalten

    If ARR_Import(1, ixx) = "Sales order" Then

        ARR_Data(3, 1) = "Sales order number"

        ARR_Data(3, 2) = ARR_Import(2, ixx)

    End If

    

    If ARR_Import(1, ixx) = "Name of Ship to Party" Then

        ARR_Data(11, 1) = "Customer"

        ARR_Data(11, 2) = ARR_Import(2, ixx)

    End If

    

    If ARR_Import(1, ixx) = "Name of Sales district" Then

        ARR_Data(15, 1) = "Region"

        ARR_Data(15, 2) = ARR_Import(2, ixx)

    End If

    

    If ARR_Import(1, ixx) = "Ship to Party" Then

        ARR_Data(9, 1) = "Kundennummer"

        ARR_Data(9, 2) = ARR_Import(2, ixx)

    End If

    

Next ixx



MsgBox _

    ARR_Data(3, 1) & ": " & ARR_Data(3, 2) & vbNewLine & _

    ARR_Data(11, 1) & ": " & ARR_Data(11, 2) & vbNewLine & _

    ARR_Data(15, 1) & ": " & ARR_Data(15, 2) & vbNewLine & _

    ARR_Data(9, 1) & ": " & ARR_Data(9, 2)



GetDataClosedWB = True



Exit Function

InvalidInput:

MsgBox "Die Quelldatei oder der Quellbereich ist ungültig!", vbExclamation, "Get data from closed Workbook"

GetDataClosedWB = False



End Function



Public Sub HoleDaten()

Dim Pfad            As String

Dim Dateiname       As String

Dim Blatt           As String

Dim Bereich         As String

Dim Ziel            As Range



Pfad = "C:\Users\05_Tools\15_SAPExport\"

Dateiname = "Export_Sample.xlsx"

Blatt = "Format"

Bereich = "A1:DZ1000"



With ThisWorkbook

    .Sheets.Add after:=Sheets(Worksheets.Count)

    .ActiveSheet.Name = "Import"

    .Activate

End With



Set Ziel = ActiveSheet.Range("A1")



If GetDataClosedWB(Pfad, Dateiname, Blatt, Bereich, Ziel) Then

    MsgBox "Daten importiert"

End If



Application.DisplayAlerts = False

Worksheets("Import").Delete

Application.DisplayAlerts = True



End Sub

So richtig gut gefällt mir das noch nicht ...

Es wird aktuell in die Tabelle geschrieben, um die Werte in mein Array ("Array_Import") zu bekommen.
Das ist etwas "unschön" wie ich finde.

Aus diesem Grund erzeuge ich ein neues Tabellenblatt Names "Import" und füge hier die Daten ein.
Aber gut finde ich das persönlich auch nicht.

=> Wie bekomme ich die Daten ohne Einträge in mein Array?!

Grüße
Stefan

Beliebteste Forumthreads (12 Monate)

Bereich einer geschlossenen Excel-Tabelle in Array

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Bereich einer geschlossenen Excel-Tabelle in Array

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

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread