Daten neu anordnen

[peacescorer]

Liebe Freunde!

Da ich nun fast eine Woche Google, dieses Forum und Co vergeblich nach einer Lösung durchforstet habe, bitte ich euch um Hilfe...

Ich habe eine Tabelle erstellt, welche es mir in der Firma ermöglichen soll, Ausmasse schnell und unkompliziert zu erfassen (Bisher Bleistift und Block...)

Dazu wird im ersten Sheet "Katalog" die benötigen Positionen per Doppelklick ausgewählt. Im zweiten Sheet "Erfassung" alle Positionen des Katalogs übertragen und die nicht verwendeten ausgeblendet. (Ginge vermutlich eleganter...) Ausserdem werden hier Stockwerk, Raum, etc. angegebenen sowie die zugehörigen Maße. Außerdem kann ich wieder per Doppelklick die Positionen auswählen, die relevant für dieses Mass ist. 

Das Sheet "Auswertung" ist eigentlich eine Kopie von "Erfassung", in welcher mir die Tabelle die Werte ermittelt. So, nun das Problem...:

Ich möchte/muss ich die Daten in 4. Sheet "Ausmass-Protokoll" neu bzw. anders anordnen. Dabei soll Excel jeweils eine Position (K5-DF5) übertragen, schauen ob in der Spalte darunter Werte stehen und die Werte C? - I? der jeweiligen Zeile übertragen. Schlussendlich sollte er alle ausgewählten Positionen und Mengen übertragen...

Ich wäre um eure Hilfe unheimlich dankbar!


Gruß Christian

PS: Datei im Anhang!

[shift-del]

Hallo Christian

Ich hatte hier ja schon mal darauf hingewiesen dass man das Ganze wesentlich komprimierter gestalten kann.

[peacescorer]

Hallo shift-dell!

Danke für deine Rückmeldung. Das man die "Vorgeschichte" zur Ausmassermittlung anders gestalten könnte ist mir klar... hatte unzählige Versionen am Reisbrett! Jedoch schien mir diese Version die sinnvollste um meine Arbeitskollegen von der "Papier und Bleistift-Überzeugung" wegzubringen. Es muss so einfach wie möglich und dabei sehr übersichtlich sein...

Abgesehen davon löst auch eine andere Darstellung mein Problem nicht. Dieses Ausmass-Protokoll ist eine Art Standard, den ich unabhängig vom Design, Optimierungen, etc. der vorigen Massermittlung erreichen sollte... sonst rennen wir in 10 Jahren noch mit Block und Papier durch die Baustellen...

Danke für dein Verständnis und nichts für ungut...

Hast du eine Idee zur Übernahme dieser Daten in das Sheet "Ausmass-Protokoll"?

Christian

[shift-del]

Hast du eine Idee zur Übernahme dieser Daten in das Sheet "Ausmass-Protokoll"?

Die zu verwendende Funktion ist INDEX(). Das Problem ist nur die Parameterwerte für die Zeile und für die Spalte zu bestimmen.

[Kuwer]

Hallo Christian,

folgender Code kommt in das schon vorhandene VBA-Modul des Tabellenblattes "Ausmassprotokoll":

' **************************************************************

'  Modul:  Tabelle4  Typ = Element der Mappe(Sheet, Workbook, ...)

' **************************************************************



Private Sub Worksheet_Activate()

 Dim i As Long

 Dim lngSpalteA As Long, lngSpalteP As Long, lngZeileA As Long, lngZeileP As Long

 Dim rngProtokoll As Range

 Dim varAuswertung As Variant, varProtokoll As Variant

 

 varAuswertung = Worksheets("Auswertung").Range("C8").CurrentRegion.Resize(, 35).Value

 ReDim varProtokoll(1 To UBound(varAuswertung, 1) * (UBound(varAuswertung, 2) - 8), 1 To 7)

 

 For lngSpalteA = 9 To UBound(varAuswertung, 2)

   If Len(varAuswertung(1, lngSpalteA)) = 0 And varAuswertung(5, lngSpalteA) > 0 Then

     lngZeileP = lngZeileP + 1

     varProtokoll(lngZeileP, 1) = varAuswertung(3, lngSpalteA)

     varProtokoll(lngZeileP, 2) = varAuswertung(2, lngSpalteA)

     varProtokoll(lngZeileP, 3) = varAuswertung(4, lngSpalteA)

     varProtokoll(lngZeileP, 5) = varAuswertung(5, lngSpalteA)

     For lngZeileA = 6 To UBound(varAuswertung, 1)

       If Len(varAuswertung(lngZeileA, lngSpalteA)) Then

         lngZeileP = lngZeileP + 1

         For i = 1 To 3

           If Len(varAuswertung(lngZeileA, i)) Then

             If Len(varProtokoll(lngZeileP, 2)) Then varProtokoll(lngZeileP, 2) = varProtokoll(lngZeileP, 2) & ", "

             varProtokoll(lngZeileP, 2) = varProtokoll(lngZeileP, 2) & varAuswertung(lngZeileA, i)

           End If

         Next i

         varProtokoll(lngZeileP, 4) = varAuswertung(lngZeileA, 4) & "*" & varAuswertung(lngZeileA, 5)

         varProtokoll(lngZeileP, 5) = varAuswertung(lngZeileA, lngSpalteA)

       End If

     Next lngZeileA

   End If

 Next lngSpalteA

 Application.ScreenUpdating = False

 With Me    'Worksheets("Ausmassprotokoll")

   .Range("A6").Resize(.Rows.Count - 5, 7).Clear

   Set rngProtokoll = .Range("A6").Resize(UBound(varProtokoll, 1), UBound(varProtokoll, 2))

   rngProtokoll.Value = varProtokoll

   With rngProtokoll.Columns(1).SpecialCells(xlCellTypeConstants)

     .NumberFormat = "#,###"

     Application.Intersect(.EntireRow, rngProtokoll.EntireColumn).Font.Bold = True

   End With

 End With

 Application.ScreenUpdating = True

End Sub

Code eingefügt mit: Excel Code Jeanie

Gruß Uwe

[peacescorer]

Uwe...

Ich verneige mich in Demut vor dir!!!!

EINFACH NUR PHANTASTISCH!!!

Vielen, vielen Dank! Es funktioniert einfach nur perfekt! 

PS: Hast du einen Rat bezüglich Lektüre oder ähnliches... Masse mir nicht an, jemals deinen Wissenstand zu erhalten, aber ich möchte mich weiterbilden...

Nochmals vielen lieben Dank!

Gruß Christian

[Kuwer]

Hallo Christian,

PS: Hast du einen Rat bezüglich Lektüre oder ähnliches...

meine Empfehlungen wären:

http://www.clever-excel-forum.de/Forum-B...-Workshops

http://excelformeln.de/uberuns.html

http://www.online-excel.de/index.php

https://de.wikibooks.org/wiki/VBA_in_Excel

Gruß Uwe