Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Liste umgruppieren

Betrifft: Liste umgruppieren von: Wilfied
Geschrieben am: 30.10.2012 11:08:12

Hallo Franz, hallo Leutz,

leider kriege ich meinen alten Beitrag nicht mehr als noch offen deklariert, daher habe ich jetzt einen neuen aufgemacht, weil mir noch eine ganze Kleinigkeit fehlt.

ok.....
ich bin nun in der Evolutionsstufe etwas weiter gekommen und wende das Umgruppierungsmakro für 2 Fälle an.

das ursprüngliche Makro:

Sub Daten_umgruppieren()
  Dim wks As Worksheet
  Dim Zeile As Long, Zeile1 As Long, ZeileLetzte As Long, SpaKey As Long, SpaWert As Long
  Dim sMsgTitel As String
  Dim StatusCalc As Long
  Dim varKey
  'Makrobremsen lösen
  With Application
    .EnableEvents = False
    StatusCalc = .Application.Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
  End With
  sMsgTitel = "Daten in Zeilen umgruppieren"
  On Error GoTo Fehler
  
  Set wks = ActiveSheet 'oder = Worksheets("Tabelle1")
  'Blatt mit Daten zum Umgruppieren kopieren
  wks.Copy After:=wks
  
  Set wks = ActiveSheet
  
  With wks
    'Titelzeile einfügen
    .Rows(1).Insert
    .Cells(1, 1).Value = "MyDate"
    .Cells(1, 2).Value = "MyNumber"
    .Cells(1, 3).Value = "Total Qty"
    .Cells(1, 4).Value = "Spinst 01"
    .Cells(1, 5).Value = "Time 01"
    .Cells(1, 6).Value = "Mat cost 01"
    .Cells(1, 7).Value = "Labour cost 01"
    .Cells(1, 8).Value = "Total cost 01"
    .Cells(1, 9).Value = "Spinst 02"
    .Cells(1, 10).Value = "Time 02"
    .Cells(1, 11).Value = "Mat cost 02"
    .Cells(1, 12).Value = "Labour cost 02"
    .Cells(1, 13).Value = "Total cost 02"
    .Cells(1, 14).Value = "Spinst 03"
    .Cells(1, 15).Value = "Time 03"
    .Cells(1, 16).Value = "Mat cost 03"
    .Cells(1, 17).Value = "Labour cost 03"
    .Cells(1, 18).Value = "Total cost 03"
    
    
    SpaKey = 2                                    'Spalte mit den zu vergleichenden Werten
    SpaWert1 = 4                                   'Spalte mit den zu übertragenden Werten
    SpaWert2 = 5
    SpaWert3 = 6
    SpaWert4 = 7
    SpaWert5 = 8
    ZeileLetzte = .Cells(.Rows.Count, SpaKey).End(xlUp).Row
    If ZeileLetzte <= 2 Then
      MsgBox "Keine Daten zum umgruppieren vorhanden", _
          vbInformation + vbOKOnly, sMsgTitel
    Else
      For Zeile = 2 To ZeileLetzte
        If .Cells(Zeile, SpaKey).Value <> "" Then
          If varKey <> .Cells(Zeile, SpaKey).Value Then
            varKey = .Cells(Zeile, SpaKey).Value
            Zeile1 = Zeile
          Else
            .Cells(Zeile1, .Columns.Count).End(xlToLeft).Offset(0, 1).Value = _
                  .Cells(Zeile, SpaWert1).Value
                  .Cells(Zeile1, .Columns.Count).End(xlToLeft).Offset(0, 1).Value = _
                  .Cells(Zeile, SpaWert2).Value
                  .Cells(Zeile1, .Columns.Count).End(xlToLeft).Offset(0, 1).Value = _
                  .Cells(Zeile, SpaWert3).Value
                  .Cells(Zeile1, .Columns.Count).End(xlToLeft).Offset(0, 1).Value = _
                  .Cells(Zeile, SpaWert4).Value
                  .Cells(Zeile1, .Columns.Count).End(xlToLeft).Offset(0, 1).Value = _
                  .Cells(Zeile, SpaWert5).Value
            .Rows(Zeile).ClearContents
          End If
        Else
          .Rows(Zeile).ClearContents
        End If
      Next
      'Leere Zeilen löschen
      With .Range(.Cells(1, SpaKey), .Cells(ZeileLetzte, SpaKey))
        .SpecialCells(xlCellTypeBlanks).EntireRow.Delete shift:=xlShiftUp
      End With
      .Columns.AutoFit
      'Fehlerbehandlung
Fehler:
  With Err
    Select Case .Number
      Case 0 'kein Fehler
      Case Else
        MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, vbOKOnly, sMsgTitel
    End Select
  End With
Beenden:
'Makrobremsen zurücksetzen
  With Application
    .EnableEvents = True
    .Calculation = StatusCalc
    .ScreenUpdating = True
  End With
  End If
End With
End Sub
erfüllt seinen Zweck, auch wenn ich hier wieder die unsaubere Spaltenkopfbenamung gewählt habe.
das einzige Thema was ich jetzt noch habe ist, dass das Makro das Ergebnis in ein vorhandenes Tabellenblatt schreiben soll, was "Ergebnis" heißt.
Im Moment generiert es immer eine Kopie des Originalblattes und hängt (2) dahinter. Ist dieses Blatt schon vorhanden macht das Makro (3).
Ich muss die Ergebnisse aber über einen Sverweis weiter verarbeiten, den ich gerne in einem dritten Blatt schon vordefinieren möchte, was mir aber nicht gelingt wenn ich den Blattnamen nicht schon habe.

sorry für das doppelte posting, Will

  

Betrifft: AW: Liste umgruppieren von: Klaus M.vdT.
Geschrieben am: 31.10.2012 12:26:14

Hi,

das geht zB so:

  wks.Copy After:=wks
  
  Set wks = ActiveSheet
  
  With wks
    wks.name = "Ergebnis"
    'Titelzeile einfügen
    .Rows(1).Insert
Grüße,
Klaus M.vdT.


  

Betrifft: AW: Liste umgruppieren von: Wilfied Jansen
Geschrieben am: 31.10.2012 13:01:36

leider nicht... :-)

es taucht der Fehler mit der Nummer.: 1004 auf
cannot rename a sheet to the same name as another sheet, a referenced object library or a workbook referenced by Visual Basic.

Ich glaube das Thema hier ist, dass die Tabelle "Ergebnis" bereits existiert.

ich kann die Tabelle auch nicht löschen, weil in einer dritten Tabelle diese Tabelle "Ergebnis" als Sverweis hinterlegt ist.
Lösche ich die im Template vorhandene Tabelle "Ergebnis" verliert der Sverweis seine Referenz, aber dafür funktioniert dann das Makro...

Will


  

Betrifft: AW: Liste umgruppieren von: Klaus M.vdT.
Geschrieben am: 31.10.2012 13:35:11

Hey,
ja das ist ja auch richtig so. Zwei Blätter dürfen nicht gleich heissen, Punkt.
Nehmen wir an, sie dürften ...
Deine Tabelle1 heisst "Hallo", dort steht in A1 "Welt"
deine Tabelle2 heisst auch "Hallo", aber dort steht in A1 "Neptun".
In Tabelle3 schreibst du nun die Formel: "=Hallo!A1" ... was soll deiner Meinung nach das Ergebnis sein?
Fazit: Deine ganze Herangehensweise scheitert bereits an einem Logikfehler.


Was ich verstanden habe ist, dass du mit einem SVERWEIS auf ein per Makro zu erstellendes Blatt zugreifen willst. Mein Lösungsvorschlag: nachdem das Makro eben jenes Blatt (dass dann sonstwie heissen kann) erstellt, schreibt es die SVERWEIS Formeln mit der nun vorhandenen Information des Blattnamens neu.

Das sieht dann zB so aus, wenn die Formeln in F3:F300 des Blattes "andere Tabelle" stehen:

With Sheets("andere Tabelle").Range("F3:F3000") 'hier sollen die SVERWEIS Formeln hin
    .FormulaR1C1 = "=VLOOKUP(RC[-1],'" & wks & "'!C[-2]:C[-1],3,FALSE)" 'SVERWEIS Formel
End With
Die Formel selbst musst du natürlich anpassen. Am einfachsten: Die Formel per Hand schreiben, Makrorekorder an, Zelle selektieren, F2, Enter, Makrorekorder aus. Im aufgenommenen Makro tauscht du dann den Tabellennamen gegen "&wks&" aus, um den Bezug zum neu erstellen Blatt herzustellen.

Grüße,
Klaus M.vdT.