Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

ListObjects (Tabellen) aus anderer Arbeitsmappe übertragen
#1
Huhu,

ich arbeite mit 2 Arbeitsmappen, die auf Sharepoint liegen.
Die Zielmappe soll Auswertungen in 3 verschiedenen Pivottabellen ermöglichen.
Dazu greift sie auf 3 verschiedene definierte Tabellen zu.
  • Umsatz
  • FC_Tab
  • Gebündelt

Zwei Tabellen (Umsatz, FC_Tab) werden per VBA durch Daten von anderen Tabellen einer anderen Arbeitsmappe ersetzt.
Die dritte Tabelle (Gebündelt) aggreggiert beide Tabellen.

Ich habe folgende Probleme:
  • extrem lange Berechnungszeiten habe. Was kann ich hier machen?
  • Wenn ich folgenden Code nutze, bekomme ich teilweise Fehler bei der Berechnung:
  • With Application
  • .ScreenUpdating = False
  • .Calculation = xlCalculationManual
  • .EnableEvents = False
  • End With

Folgenden Code habe ich in Modul1 geschrieben:
Sub Quellen()
Dim offen, wbz As Workbook
Workbooks.Open ("Quelle.xlsx")

Set offen = ActiveWorkbook

Dim q_FC As ListObject
Dim z_FC As ListObject
Dim q_RE As ListObject
Dim z_RE As ListObject
Dim ZZ As Long

Set q_FC = Sheets("Planung").ListObjects("FC")
Set q_RE = Sheets("Re").ListObjects("Umsatztabelle")
ThisWorkbook.Activate
Set z_FC = Sheets("FC_Q").ListObjects("FC_Tab")
Set z_RE = Sheets("RG._Q").ListObjects("Umsatz")


'we clean z_FC only if there is data
If Not Sheets("FC_Q").ListObjects("FC_Tab").DataBodyRange Is Nothing Then Sheets("FC_Q").ListObjects("FC_Tab").DataBodyRange.Delete
If Not Sheets("RG._Q").ListObjects("Umsatz").DataBodyRange Is Nothing Then Sheets("RG._Q").ListObjects("Umsatz").DataBodyRange.Delete


offen.Sheets("Planung").Range(q_FC.Name).Copy
Range(z_FC.Name).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
offen.Sheets("RE").Range(q_RE.Name).Copy
Range(z_RE.Name).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False


'we clean blanks
For ZZ = z_FC.DataBodyRange.Rows.Count To 1 Step -1
    If z_FC.DataBodyRange.Cells(ZZ, 4).Value = "" Then z_FC.ListRows(ZZ).Delete
Next ZZ
For ZZ = z_RE.DataBodyRange.Rows.Count To 1 Step -1
    If z_RE.DataBodyRange.Cells(ZZ, 4).Value = "" Then z_RE.ListRows(ZZ).Delete
Next ZZ


Set q_FC = Nothing
Set z_FC = Nothing
Set q_RE = Nothing
Set z_RE = Nothing
Gesamt
End Sub

Sub Gesamt()
Dim offen, wbz As Workbook
'Workbooks.Open ("Quelle.xlsx")
'Set offen = ActiveWorkbook

Dim q_FC As ListObject
Dim z_FC As ListObject
Dim q_RE As ListObject
Dim z_RE As ListObject
Dim z_Gebündelt As ListObject
Dim ZZ As Long

' Set q_FC = Sheets("Planung").ListObjects("FC")
' Set q_RE = Sheets("Re").ListObjects("Umsatztabelle")
ThisWorkbook.Activate
Set z_FC = Sheets("FC_Q").ListObjects("FC_Tab")
Set z_RE = Sheets("RG._Q").ListObjects("Umsatz")
Set z_Gebündelt = Sheets("Gebündelt_Q").ListObjects("Gebündelt")

'we clean z_FC only if there is data
' If Not Sheets("FC_Q").ListObjects("FC_Tab").DataBodyRange Is Nothing Then Sheets("FC_Q").ListObjects("FC_Tab").DataBodyRange.Delete
' If Not Sheets("RG._Q").ListObjects("Umsatz").DataBodyRange Is Nothing Then Sheets("RG._Q").ListObjects("Umsatz").DataBodyRange.Delete
If Not Sheets("Gebündelt_Q").ListObjects("Gebündelt").DataBodyRange Is Nothing Then Sheets("Gebündelt_Q").ListObjects("Gebündelt").DataBodyRange.Delete


Sheets("RG._Q").Range(z_RE.Name).Copy
Range(z_Gebündelt.Name).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
Set lR = z_Gebündelt.ListRows.Add
z_FC.DataBodyRange.Copy lR.Range


Set z_FC = Nothing
Set z_RE = Nothing
Set z_Gebündelt = Nothing

End Sub


Ich freue mich über Eure Ideen!
Mfg
Antworten Top
#2
(10.06.2024, 22:53)DerNeuling schrieb: Ich habe folgende Probleme:
  • extrem lange Berechnungszeiten habe. Was kann ich hier machen?
  • Wenn ich folgenden Code nutze, bekomme ich teilweise Fehler bei der Berechnung:
  • With Application
  • .ScreenUpdating = False
  • .Calculation = xlCalculationManual
  • .EnableEvents = False
  • End With

Hi,

weil Du neu bist, folgender Hinweis: Wenn Du schon Code postest, dann verwend bitte Code-Tags. Wer soll denn den aneinandergeklatschten Code lesen? Noch besser, füge die Datei(en) an.
Hab mir jetzt nur den oben zitierten Code angesehen. Wenn Du Application Eigenschaften auf false setzt, dann musst Du sie nach Ende der durchgeführten Aktion auch wieder auf true setzen. Calculation auf xlautomatic.
Den Rest hab ich mir aus o.g. Grund nicht angesehen.
Frage: Warum nutzt Du nicht PQ für diese Aufgabe?
Der sicherste Ansatz für einen Irrtum ist der Glaube, alles im Griff zu haben.
Nur, weil ich den Recorder bedienen kann, macht mich das noch lange nicht zum Musiker.

Ciao, Ralf

Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste