Microsoft Excel

Herbers Excel/VBA-Archiv

Daten zusammenfassen

Betrifft: Daten zusammenfassen von: Mustermann83
Geschrieben am: 11.11.2012 19:51:09

https://www.herber.de/bbs/user/82585.xls

Hallo,
in der angefügten Datei möchte ich die Daten der Tabelle1 und Tabelle2 in das Tabellenblatt Werte vorher in Spalte B,C,D einfügen. Die Anzahl der Tabellen mit den Ausgangsdaten können variieren.

Danke

  

Betrifft: viel Glück...oT von: Christian
Geschrieben am: 12.11.2012 01:06:00




  

Betrifft: AW: viel Glück...oT von: Mustermann83
Geschrieben am: 12.11.2012 08:12:36

Ich, weiß ich kann die Daten einfach umkopieren, aber in der richtigen Datei sind die Datensätze länger und mehr Tabellen mit Daten. Deshalb wäre ein Makro toll, mit dem ich das Einfügen beschleunigen kann.


  

Betrifft: AW: viel Glück...oT von: Tino
Geschrieben am: 12.11.2012 10:59:46

Hallo,
kannst mal diesen Code testen.

Sub kopiereDaten()
Dim oWS As Worksheet, tmpArray, iCalc%, lngOffset&

iCalc = Application.Calculation
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

With Sheets("Werte aktuell")
    'alte Daten löschen für neue, evtl. löschen wenn nicht gewollt 
    .UsedRange.ClearContents
    For Each oWS In ThisWorkbook.Worksheets
        'alle Tabellen die Tabelle im Namen haben, 
        'evtl. anderer Filter verwenden 
        If InStr(oWS.Name, "Tabelle") > 0 Then
            With oWS
                tmpArray = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 3).Value2
            End With
            With .Cells(.Rows.Count, 1).End(xlUp).Offset(lngOffset, 0).Resize(Ubound(tmpArray), Ubound(tmpArray, 2))
                    .Value = tmpArray
                    With .Columns(1)
                        .Offset(, 6).FormulaR1C1 = "=LEFT(RC[-4],4)"
                    
                        .Offset(, 7).FormulaR1C1 = "=RIGHT(RC[-1],2)"
                    
                        .Offset(, 8).FormulaR1C1 = _
                            "=IF(OR(31-RC[-1]=0,32-RC[-1]=0),RIGHT(RC[-6],2),""xx"")"
                    
                        .Offset(, 10).FormulaR1C1 = "=RC[-10]&RC[-4]"
                    
                        .Offset(, 12).FormulaR1C1 = _
                            "=IF(RC[-4]=""xx"",RC[-12]&RC[-6],RC[-12]&RC[-6]&RC[-4])"
                    End With
            End With
            lngOffset = 1
        End If
    Next oWS
End With

Application.EnableEvents = True
Application.Calculation = iCalc
Application.ScreenUpdating = True
End Sub
Gruß Tino


  

Betrifft: AW: viel Glück...oT von: Mustermann83
Geschrieben am: 12.11.2012 12:06:37

Vielen Dank.

Es funktioniert.

Leider fügt es die Daten im Tabellenblatt Werte aktuell ab Spalte A ein. Spalte A enthält aber eine Formel. Die Daten dürfen erst ab Spalte B eingefügt werden.


  

Betrifft: AW: viel Glück...oT von: Tino
Geschrieben am: 12.11.2012 12:42:06

Hallo,
ok. noch ein Versuch.

Sub kopiereDaten()
Dim oWS As Worksheet, tmpArray, iCalc%, lngOffset&

iCalc = Application.Calculation
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

With Sheets("Werte aktuell")
    'alte Daten löschen für neue, evtl. löschen wenn nicht gewollt 
    .UsedRange.ClearContents
    For Each oWS In ThisWorkbook.Worksheets
        'alle Tabellen die Tabelle im Namen haben, 
        'evtl. anderer Filter verwenden 
        If InStr(oWS.Name, "Tabelle") > 0 Then
            With oWS
                tmpArray = .Range("A1", .Cells(.Rows.Count, 2).End(xlUp)).Resize(, 3).Value2
            End With
            With .Cells(.Rows.Count, 2).End(xlUp).Offset(lngOffset, 0).Resize(Ubound(tmpArray), Ubound(tmpArray, 2))
                    .Value = tmpArray
                    With .Columns(1)
                        .Offset(, -1).FormulaR1C1 = "=LEFT(RC[1],4)"
                        .Offset(, 5).FormulaR1C1 = "=LEFT(RC[-4],4)"
                    
                        .Offset(, 6).FormulaR1C1 = "=RIGHT(RC[-1],2)"
                    
                        .Offset(, 7).FormulaR1C1 = _
                            "=IF(OR(31-RC[-1]=0,32-RC[-1]=0),RIGHT(RC[-6],2),""xx"")"
                    
                        .Offset(, 9).FormulaR1C1 = "=RC[-10]&RC[-4]"
                    
                        .Offset(, 11).FormulaR1C1 = _
                            "=IF(RC[-4]=""xx"",RC[-12]&RC[-6],RC[-12]&RC[-6]&RC[-4])"
                    End With
            End With
            lngOffset = 1
        End If
    Next oWS
End With

Application.EnableEvents = True
Application.Calculation = iCalc
Application.ScreenUpdating = True
End Sub
Gruß Tino


 

Beiträge aus den Excel-Beispielen zum Thema "Daten zusammenfassen"