Clever-Excel-Forum

Hallo,

ich habe folgendes Makro das auch soweit funktioniert:

Code:
Sub KeyTransfer()

'Workbook

Dim Matrix As Worksheet

Dim ImportSchlüssel As Worksheet

Set Matrix = ThisWorkbook.Worksheets("Matrix")

Set ImportSchlüssel = ThisWorkbook.Worksheets("Import Schlüssel")

Dim MColKey As Long

Dim MKeyRowTimeStamp As Long

Dim MKeyRowName As Long

Dim MKeyRowPcs As Long

Dim MKeyRowLock As Long

Dim ISRow As Long

Dim ISRowKey As Long

Dim ISColKeyID As Integer

Dim ISColKeyName As Integer

Dim ISKColKeyNo As Integer

Dim ISColKeyLock As Integer

Dim ISColKeyTimeStamp As Integer

'For-Schleifen

Dim MCol As Long

Dim MColPcs As Long

'Variablen

'Matrix

MColKey = 11

MKeyRowTimeStamp = 1

MKeyRowName = 2

MKeyRowPcs = 3

MKeyRowLock = 4

'Import Zylinder

ISRowKey = 4

ISColKeyID = 1

ISColKeyName = 2

ISKColKeyNo = 3

ISColKeyLock = 4

ISColKeyTimeStamp = 18

ImportSchlüssel.Range("A4:BF1003").ClearContents

For MCol = MColKey To Matrix.Cells(MKeyRowLock, Columns.Count).End(xlToLeft).Column

    For MColPcs = 1 To Matrix.Cells(MKeyRowPcs, MCol).Value

        ISRow = ImportSchlüssel.Cells(Rows.Count, ISColKeyID).End(xlUp).Row + 1

        ImportSchlüssel.Cells(ISRow, ISColKeyID) = ISRow - 4 + 1001

        ImportSchlüssel.Cells(ISRow, ISColKeyTimeStamp) = Matrix.Cells(MKeyRowTimeStamp, MCol)

        ImportSchlüssel.Cells(ISRow, ISColKeyName) = Matrix.Cells(MKeyRowName, MCol)

        ImportSchlüssel.Cells(ISRow, ISKColKeyNo) = Matrix.Cells(MKeyRowPcs, MCol).Value - (MColPcs - 1)

        ImportSchlüssel.Cells(ISRow, ISColKeyLock) = Matrix.Cells(MKeyRowLock, MCol).Value

    Next MColPcs

Next MCol

End Sub

In der Tabelle "Matrix" werden Variable eingetragen und Stück. Quasi so:

Name Stück
Schlüssel 01 2
GHS 1
Z 2

jetzt werden alle Schlüssel in die Tabelle "ImportSchlüssel" übertragen

Name Folgenummer
Schlüssel 01 2
Schlüssel 01 1
GHS 1
Z 2
Z 1

Jetzt ist es aber so, dass es sein kann dass, in Tabelle "Matrix" ein Name öfter vorkommen kann

Name Stück
Schlüssel 01 2
GHS 1
Z 2
GHS 2

jetzt muss geprüft werden in "importSchlüssel" zum ersten: gibt es den Schlüssel bereits WENN JA soll geprüft werden welche Folgenummer die letzt höchste war

Name Folgenummer
Schlüssel 01 2
Schlüssel 01 1
GHS 1
Z 2
Z 1
GSH 3

GSH 2

Sollte es den Schlüssel noch nicht geben soll wie gehabt der Schlüssel übertragen werden.

Ich hoffe ich konnte mich genau ausdrücken ;)#

Vielen Dank euch!

Hallo,

ich hab mir Deine Anfrage nun schon drei mal durchgelesen und weiß immer noch nicht genau, was den wo stehen soll und wann welcher Wert auf das Maximum geprüft werden soll.
Mit einer anonymisierten Beispiel - Datei und Wunschergebnis wäre es viel einfacher hier einen Treffer zu erzielen.

Grüße

Norbert

Hallöchen,

wenn ein "Schlüssel" z.B. einmalig und mit Nr. 5 in der Liste steht, soll in der anderen Liste dieser Schlüssel in 5 Zeilen stehen mit den Zahlen 1-5

wenn ein Schlüssel 2x oder öfter auftaucht, wie GHS, dann werden die Zahlen anscheinend addiert, also hier 2+1, und in der anderen Liste erscheint er dann also 3x mit den Zahlen 1-3. Ob die Reihenfolge dabei eine Rolle spielt sei mal dahin gestellt ...

Hallo,

ja Schauan du hast es richtig erfasst.

Anbei habe ich ein Muster angefügt

Danke euch!

Jemand eine Idee?

Hallöchen,

Dein Code macht das doch?

Leider nicht der Code fängt mit jedem Schlüssel die folgenummer immer neu an er zählt quasi die Stück nach unten 3,2,1 aber berücksichtigt nicht die bereits vorhandenen 3,2,1 des GHS Schlüssel sollte GHS 3,2,1 drin stehen soll er die neuen 3 GHS so zählen 6,5,4

Anbei habe ich nochmals ein Muster angefügt ich hoffe es ist jetzt verständlicher

Hi

den Code mit Schaltfläche1 starten.

Code:
Public Sub Liste()

Dim Werte, Ausgabe, a As Long, b As Long, c As Long, dict As Object

Werte = Range(Range("K2"), Range("K2").End(xlToRight)).Resize(3)

ReDim Ausgabe(1 To WorksheetFunction.Sum(Application.Index(Werte, 2)), 1 To 4)

For a = 1 To UBound(Ausgabe)

   Ausgabe(a, 1) = 1000 + a    'Id

Next a

Set dict = CreateObject("Scripting.Dictionary")

  For a = 1 To UBound(Werte, 2)

    If Not dict.Exists(Werte(1, a)) Then

      dict(Werte(1, a)) = Werte(2, a)

    Else

      dict(Werte(1, a)) = dict(Werte(1, a)) + Werte(2, a)

    End If

    For b = 1 To Werte(2, a)

      c = c + 1

      Ausgabe(c, 2) = Werte(1, a)   'Bezeichnung

      Ausgabe(c, 4) = Werte(3, a)   'Schlüssel

      Ausgabe(c, 3) = dict(Werte(1, a)) - b + 1

    Next b

  Next a

Set dict = Nothing

Sheets("Tabelle2").Range("H22").Resize(UBound(Ausgabe), UBound(Ausgabe, 2)) = Ausgabe

End Sub

Hallo Elex,

auf jedenfalls schon mal vielen Dank!

In der Muster Datei Funktioniert das ganze (aber nur wenn ich die Schaltfläche Drücke aber nicht wenn ich das ganze Debuggen möchte)

Ich wollte eben das ganze in meine Produktivdatei einbinden (Zellen sind die selben) aber dein Code bleibt immer hier stehen:

ReDim Ausgabe(1 To WorksheetFunction.Sum(Application.Index(Werte, 2)), 1 To 4)

Kannst du mir vielleicht kurz erklären was diese Funktion macht?

tomcat

NobX

schauan

tomcat

tomcat

schauan

tomcat

tomcat

Elex

tomcat