Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1104to1108
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

@Tino, Kommentierung von Deinem Beispiel

@Tino, Kommentierung von Deinem Beispiel
Deinem
Hallo Tino,
ist die Kommentierung von Deinem Code so einigermassen zutreffend ? Habe mal versucht es soweit wie möglich zu machen. Es war Dein Beispiel mit den Gruppieren von Datensätzen.
DU darfst gerne noch ergänzen, wenn was fehlt, sonst weiss ich in ein paar Wochen nicht mehr, was da genmacht wird.
PS: vielleicht noch eine Frage : kann ich die betroffenen datensätze (mit gleichem Kriterium in V) irgend wie farblich (font) markieren, damit ich nachher noch sehen kann, welche Datensätze vom zusammenfassen betroffen waren.
Das wäre aber nur noch ein Guddi, ist nicht notwendig.
Danke
<pre>Sub Aufbereiten4()
Dim Bereich As Range
Dim LRow As Long, A As Long, B As Long, varRow
Dim meAR1, meAR2, meAr3, meAr4, meAr5
Dim iCalc As Integer
Dim LenZ As Integer
'hier Trennzeichen angeben
Const TrennZeichen As String = " ### "
LenZ = Len(TrennZeichen)
With Application
iCalc = .Calculation
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
With Sheets("Datenseite") 'Tabellennamen anpassen
' prüfen ob Daten ab Zeile 11 vorhanden sind
If .Cells(.Rows.Count, 22).End(xlUp).Row > 10 Then
' verweis auf letzte Spalte in Tabelle (Hilfsspalte)
' unter xl2007 = Spalte 256, ab xl2007 = Spalte 16384
With .Range("V10", .Cells(.Rows.Count, 22).End(xlUp)).Offset(0, .Columns.Count - 22)
meAR2 = .Offset(0, -(.Column - 22))
meAr3 = .Offset(0, -(.Column - 22))
meAR1 = .Offset(0, -(.Column - 4)) 'Spalte D = 4
meAr4 = .Offset(0, -(.Column - 3)) 'Spalte C = 3
meAr5 = .Offset(0, -(.Column - 21)) 'Spalte U = 21
' hier werden die Texte zusammengefasst,
For A = 1 To UBound(meAR1)
meAR1(A, 1) = TrennZeichen & meAR1(A, 1) & TrennZeichen
meAr4(A, 1) = TrennZeichen & meAr4(A, 1) & TrennZeichen
meAr5(A, 1) = TrennZeichen & meAr5(A, 1) & TrennZeichen
' ist in Sp. V ein X oder ist diese leer?
If meAR2(A, 1) <> "" And meAR2(A, 1) <> "S" Then
B = A 'Hilfszähler
varRow = Application.Match(meAR2(A, 1), meAr3, 0)
Do While IsNumeric(varRow)
If meAR2(varRow, 1) <> "" And meAR2(varRow, 1) <> "S" Then
If B > A Then
If InStr(meAR1(A, 1), TrennZeichen & meAR1(varRow, 1) & TrennZeichen) = 0 Then
meAR1(A, 1) = meAR1(A, 1) & meAR1(varRow, 1) & TrennZeichen
End If
If InStr(meAr4(A, 1), TrennZeichen & meAr4(varRow, 1) & TrennZeichen) = 0 Then
meAr4(A, 1) = meAr4(A, 1) & meAr4(varRow, 1) & TrennZeichen
End If
If InStr(meAr5(A, 1), TrennZeichen & meAr5(varRow, 1) & TrennZeichen) = 0 Then
meAr5(A, 1) = meAr5(A, 1) & meAr5(varRow, 1) & TrennZeichen
End If
End If
End If
' was anderes schreiben damit wert nicht zweimal gefunden wird
meAr3(varRow, 1) = "@@@@@"
' Suche weiter in Liste
varRow = Application.Match(meAR2(A, 1), meAr3, 0)
B = B + 1 'Hilfszähler ein hoch
Loop
End If
If Right$(meAR1(A, 1), LenZ) = TrennZeichen Then meAR1(A, 1) = Left$(meAR1(A, 1), Len(meAR1(A, 1)) - LenZ)
If Left$(meAR1(A, 1), LenZ) = TrennZeichen Then meAR1(A, 1) = Right$(meAR1(A, 1), Len(meAR1(A, 1)) - LenZ)
If Right$(meAr4(A, 1), LenZ) = TrennZeichen Then meAr4(A, 1) = Left$(meAr4(A, 1), Len(meAr4(A, 1)) - LenZ)
If Left$(meAr4(A, 1), LenZ) = TrennZeichen Then meAr4(A, 1) = Right$(meAr4(A, 1), Len(meAr4(A, 1)) - LenZ)
If Right$(meAr5(A, 1), LenZ) = TrennZeichen Then meAr5(A, 1) = Left$(meAr5(A, 1), Len(meAr5(A, 1)) - LenZ)
If Left$(meAr5(A, 1), LenZ) = TrennZeichen Then meAr5(A, 1) = Right$(meAr5(A, 1), Len(meAr5(A, 1)) - LenZ)
Next A
' Letzte Zeile?
LRow = .Rows(.Rows.Count).Row
' A summieren
.FormulaR1C1 = "=IF(OR(RC22="""",RC22=""S""),RC5,IF(COUNTIF(R10C22:RC22,RC22)=1," & _
"SUMIF(R10C22:R" & LRow & "C22,RC22,R10C5:R" & LRow & "C1),""""))"
' und zurück schreiben
.Offset(0, -(.Column - 1)).Value = .Value
' E summieren
.FormulaR1C1 = "=IF(OR(RC22="""",RC22=""S""),RC5,IF(COUNTIF(R10C22:RC22,RC22)=1," & _
"SUMIF(R10C22:R" & LRow & "C22,RC22,R10C5:R" & LRow & "C5),""""))"
' Daten zurück schreiben
.Offset(0, -(.Column - 5)).Value = .Value
.Offset(0, -(.Column - 4)) = meAR1 'Spalte D schreiben
.Offset(0, -(.Column - 3)) = meAr4 'Spalte C schreiben
.Offset(0, -(.Column - 21)) = meAr5 'Spalte U schreiben
' Formel für die Summierung der Werte
.FormulaR1C1 = "=IF(OR(COUNTIF(R10C22:RC22,RC22)=1,RC22="""",RC22=""S""),ROW(),TRUE)"
' Tebellenname Zelle, damit nicht doppelt angegeben werden muss
With Sheets(.Parent.Name)
.Range("A10", .Cells(LRow, .Columns.Count)).Sort Key1:=.Cells(10, .Columns.Count), Order1:=xlAscending, Header:=xlNo
End With
On Error Resume Next
' Zeilen löschen die das Ergebnis Wahr haben
.SpecialCells(xlCellTypeFormulas, 4).EntireRow.Delete
' Hilfsspalte komplett löschen
.EntireColumn.Delete
On Error GoTo 0
End With
.Range("A:V").Columns.AutoFit
End If
End With
.Calculation = iCalc
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub</pre>

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
Soweit ich mich noch erinnere,
06.10.2009 16:24:31
Tino
Hallo,
habe ich mal noch etwas dazugeschrieben.
In der Zeile
.Offset(0, -(.Column - 22)).Interior.ColorIndex = 5
sollte die Färbung der Zellen stattfinden, kannst ja mal testen.
(habe nicht getestet, keine Testdatei mehr)
Sub Aufbereiten4()

Dim Bereich As Range
Dim LRow As Long, A As Long, B As Long, varRow
Dim meAR1, meAR2, meAr3, meAr4, meAr5
Dim iCalc As Integer
Dim LenZ As Integer

'hier Trennzeichen angeben 
Const TrennZeichen As String = " ### "
LenZ = Len(TrennZeichen)

With Application
    iCalc = .Calculation
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    
    With Sheets("Datenseite") 'Tabellennamen anpassen 
        ' prüfen ob Daten ab Zeile 11 vorhanden sind 
        If .Cells(.Rows.Count, 22).End(xlUp).Row > 10 Then
        ' verweis auf letzte Spalte in Tabelle (Hilfsspalte) 
        ' unter xl2007 = Spalte 256, ab xl2007 = Spalte 16384 
        With .Range("V10", .Cells(.Rows.Count, 22).End(xlUp)).Offset(0, .Columns.Count - 22)
            
            meAR2 = .Offset(0, -(.Column - 22)) 'Spalte V = 22 
            meAr3 = .Offset(0, -(.Column - 22)) 'Spalte V = 22 zusätzliche Hilfs Array 
            meAR1 = .Offset(0, -(.Column - 4)) 'Spalte D = 4 
            meAr4 = .Offset(0, -(.Column - 3)) 'Spalte C = 3 
            meAr5 = .Offset(0, -(.Column - 21)) 'Spalte U = 21 
            
            ' hier werden die Texte zusammengefasst, 
            For A = 1 To Ubound(meAR1)
                meAR1(A, 1) = TrennZeichen & meAR1(A, 1) & TrennZeichen
                meAr4(A, 1) = TrennZeichen & meAr4(A, 1) & TrennZeichen
                meAr5(A, 1) = TrennZeichen & meAr5(A, 1) & TrennZeichen
                ' ist in Sp. V ein S oder ist diese leer? 
                If meAR2(A, 1) <> "" And meAR2(A, 1) <> "S" Then
                    B = A 'Hilfszähler 
                     
                    'Wert aus Spalte V 
                    varRow = Application.Match(meAR2(A, 1), meAr3, 0)
                    
                    'Schleife bis keine Übereinstimmung in Spalte V 
                    Do While IsNumeric(varRow)
                        If meAR2(varRow, 1) <> "" And meAR2(varRow, 1) <> "S" Then
                        If B > A Then
                        
                        If InStr(meAR1(A, 1), TrennZeichen & meAR1(varRow, 1) & TrennZeichen) = 0 Then
                        meAR1(A, 1) = meAR1(A, 1) & meAR1(varRow, 1) & TrennZeichen
                        End If
                        
                        If InStr(meAr4(A, 1), TrennZeichen & meAr4(varRow, 1) & TrennZeichen) = 0 Then
                        meAr4(A, 1) = meAr4(A, 1) & meAr4(varRow, 1) & TrennZeichen
                        End If
                        
                        If InStr(meAr5(A, 1), TrennZeichen & meAr5(varRow, 1) & TrennZeichen) = 0 Then
                        meAr5(A, 1) = meAr5(A, 1) & meAr5(varRow, 1) & TrennZeichen
                        End If
                        
                        End If
                        End If
                        ' was anderes schreiben damit wert nicht zweimal gefunden wird 
                        meAr3(varRow, 1) = "@@@@@"
                        ' Suche weiter in Liste 
                        varRow = Application.Match(meAR2(A, 1), meAr3, 0)
                        B = B + 1 'Hilfszähler ein hoch 
                    Loop
                
                End If
                'nicht benötigte Zeichen aus String löschen 
                If Right$(meAR1(A, 1), LenZ) = TrennZeichen Then meAR1(A, 1) = Left$(meAR1(A, 1), Len(meAR1(A, 1)) - LenZ)
                If Left$(meAR1(A, 1), LenZ) = TrennZeichen Then meAR1(A, 1) = Right$(meAR1(A, 1), Len(meAR1(A, 1)) - LenZ)
                If Right$(meAr4(A, 1), LenZ) = TrennZeichen Then meAr4(A, 1) = Left$(meAr4(A, 1), Len(meAr4(A, 1)) - LenZ)
                If Left$(meAr4(A, 1), LenZ) = TrennZeichen Then meAr4(A, 1) = Right$(meAr4(A, 1), Len(meAr4(A, 1)) - LenZ)
                If Right$(meAr5(A, 1), LenZ) = TrennZeichen Then meAr5(A, 1) = Left$(meAr5(A, 1), Len(meAr5(A, 1)) - LenZ)
                If Left$(meAr5(A, 1), LenZ) = TrennZeichen Then meAr5(A, 1) = Right$(meAr5(A, 1), Len(meAr5(A, 1)) - LenZ)
            Next A
            
            ' Letzte Zeile? 
            LRow = .Rows(.Rows.Count).Row
            
            ' A summieren 
            .FormulaR1C1 = "=IF(OR(RC22="""",RC22=""S""),RC5,IF(COUNTIF(R10C22:RC22,RC22)=1," & _
            "SUMIF(R10C22:R" & LRow & "C22,RC22,R10C5:R" & LRow & "C1),""""))"
            ' und zurück schreiben 
            .Offset(0, -(.Column - 1)).Value = .Value
            
            ' E summieren 
            .FormulaR1C1 = "=IF(OR(RC22="""",RC22=""S""),RC5,IF(COUNTIF(R10C22:RC22,RC22)=1," & _
            "SUMIF(R10C22:R" & LRow & "C22,RC22,R10C5:R" & LRow & "C5),""""))"
            
            ' Daten zurück schreiben 
            .Offset(0, -(.Column - 5)).Value = .Value
            .Offset(0, -(.Column - 4)) = meAR1 'Spalte D schreiben 
            .Offset(0, -(.Column - 3)) = meAr4 'Spalte C schreiben 
            .Offset(0, -(.Column - 21)) = meAr5 'Spalte U schreiben 
            
            .Offset(0, -(.Column - 22)).Interior.ColorIndex = 5 'Spalte V färben <---------------------------------------------- 
            
            ' Formel für die Summierung der Werte 
            .FormulaR1C1 = "=IF(OR(COUNTIF(R10C22:RC22,RC22)=1,RC22="""",RC22=""S""),ROW(),TRUE)"
            
            ' Tebellenname Zelle, damit nicht doppelt angegeben werden muss 
            With Sheets(.Parent.Name)
             .Range("A10", .Cells(LRow, .Columns.Count)).Sort Key1:=.Cells(10, .Columns.Count), Order1:=xlAscending, Header:=xlNo
            End With
            
            
            On Error Resume Next
            ' Zeilen löschen die das Ergebnis Wahr haben 
            .SpecialCells(xlCellTypeFormulas, 4).EntireRow.Delete
            ' Hilfsspalte komplett löschen 
            .EntireColumn.Delete
            On Error GoTo 0
        
        
        End With
        'Spalte A bis V optimale Breite einstllen 
        .Range("A:V").Columns.AutoFit
        
        End If
        
    End With
    
    .Calculation = iCalc
    .ScreenUpdating = True
    .EnableEvents = True

End With

End Sub
Gruß Tino
Anzeige
Danke Tino, ist OK :-) owT
07.10.2009 10:58:27
Joachim

300 Forumthreads zu ähnlichen Themen


Liebe Excel-Gemeinde,
ich möchte aus einer csv-Datei (die eine konstante Spalten- aber unterschiedliche Zeilenzahl hat) Text in Zahlen wandeln (also z. B. 1.234 in 1,234).
Dazu gibts im Forum viele Vorschläge. Ich habe dazu die Formel =WERT(WECHSELN(A1;".";",")) gefunden.
Diese Fo...
Anzeige

Hallo zusammen,
vor zwei Tagen (Beitrag 20.08.2008 11:10:17) wurde mir hier im Forum erfolgreich bei dem Thema "Kombination aus gruppierten und gestapelten Säulen" geholfen. Beverly hat mein Problem gelöst i n dem ein Teil der Daten der Primär- und ein anderer Teil der Sekundärachse zugetei...

Hallo liebe Excel-Experten,
es wäre nett, wenn Ihr mir helfen könntet.
Ich habe verschiedene (mehr als 50) Diagramme erzeugt, dabei gibt es übergeordnete Diagramme und Diagramme, die Details betreffen.
Natürlich kann sich der Betrachter über die Diagramm-Namen durchsuchen. Ich möcht...
Anzeige

Hallo Zusammen!
Folgendes Problem würde ich gerne lösen, weiß aber nicht wie :)
Ich habe in Spalte A in jeder Zeile Uhrzeiten stehen:
00:15:00
00:30:00
00:45:00
01:00:00
01:15:00
01:30:00
01:45:00
02:00:00
02:15:00
02:30:00
02:45:00
...

Hallo und guten Abend!!!
Brauche wieder einmal eure Hilfe!!!
In einer Tabelle Namens Hilfsblatt werden in Spalte O die Daten aus den Spalten I & K zusammengefasst (z.B. =I5&K5). Der Wert aus Spalte P wird mittels folgender Formel
=WENN(ISTFEHLER(SVERWEIS($B2&C$1;Hilfsbl...

Hallo an alle,
die Linien in meinem Liniendiagramm werden nicht ganz gerade,
sondern sind gerastert.
Woran liegt es bzw. was kann ich machen?
Vielen Dank für Eure Hilfe.
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige