'
'
Sub IndexMaker()
Rem 1 Arbeitsblätter Info. und Haupt Variablen
Dim vTemp As Variant 'Evtl. benutz im Debugging
Dim wsIn As Worksheet, wsOutIn As Worksheet 'Dieses variablen definieret als Objekte Arbeitsblätter ( Worksheets)
Set wsIn = ThisWorkbook.Worksheets("Index"): Set wsOutIn = ThisWorkbook.Worksheets("Output") 'Gibt die verkürzen Buchstaben im Code Methoden, Eigenschaften usw. von Objekte Arbeitsblätter ( Worksheets) durch Anwendung die .Punkt danach
wsIn.Range("A1").CurrentRegion.ClearContents
Dim Zelle As Range
Dim ZellValue2 As String 'Wann mogliech bemutz variablen für Zelle Werte um zu mimieren wenn AbeitsBlätter ist referenziert, ( bein suche nach Unterstriche muss es, abe für werte nicht
Dim lr As Long: Let lr = wsOutIn.Cells(Rows.Count, 2).End(xlUp).Row 'So in Spalte 2 der letzte Bereich (Zelle) hat die End-Eigenschaft (mit Parameter (Argument) Up) angewandt, um einen anderen Bereich (Zelle) zurückzugeben, bzw. die letzte Zelle mit eine Eintrag in ist. Anwendung Die Row Eigenschaft auf diesen Bereich (Zelle) gibt die Zeile Nummer dieses Zelle
Rem Verwenden Sie Microsoft Scripting Rintime Dictionary ( Wörterbuch ) um eindeutige Schlüssel referance Worte zu kreigen
'Wir "quasi" stellen also eindeutige Werte in einem Wörterbuch für spätere Nachschlagzwecke:
'-erfordert Bibliothek Verweis auf MS Scripting Runtime ( Early Binding ) -
'Extras >> Verweis >> scrolle nach unten und selektieren das Kontrollkästchen neben Microsoft Scripting Runtime
' ..oder Stürzt am nächsten Zeile
' Dim dicOb As Scripting.Dictionary ' Daten hier hat einem eindeutigen "Schlüssel" oder Teilenummer
' Set dicOb = New Scripting.Dictionary
'Die nächsten beiden Zeilen sind eine Alternative genannt Late Bindung . (Beachten Sie aber einige Dictionary Methoden und Eigenschaften werden nicht mit ihm arbeiten - in den Fällen, Early muss verwendet werden. )
Dim dicOb As Object
Set dicOb = CreateObject("Scripting.Dictionary") 'Späte Bindung ist besser, wenn man Austausch von Dateien will , so wie ich hier. Early Binding hat den Vorteil, dass Excel Intellisense
' Wird dann für die Microsoft Scripting Runtime Sachen zeigen, nachdem man die .DOT gibt
Rem 3 Selection basieret an ausgewählt berisch in wsIn
Dim rngSel As Range: 'Set rngSel = wsOutIn.Range("A2:D10") 'Test Bereich ('Bereich soll ausgewählt ab Spalten B
With wsOutIn 'Ab hier alles wie .fgfg bedeutet wsIn.fgfg------------------------------------------------
Set rngSel = .Range(.Cells(Selection.Row, Selection.Column), .Cells(Selection.Row + Selection.Rows.Count - 1, Selection.Column + Selection.Columns.Count - 1)) 'Selection Bereich gefunden von eigenschaften Selection Objekt. Diese Objekt hat Info übers Selected Teil von Arbeitsblätter drin
Rem Output Arrays
Dim arrOutIn() As Variant: Let arrOutIn() = rngSel.Value2 'Wenn die Eigenschaft .Value 2 auf einen Bereich von mehr als 1 Zelle angelegt ist, kehrt ein Kollektion (Array) der meist basis Werte alle Zellen in diesem Bereich zuruck . VBA ermöglicht einen "One -Liner", um dann tu anweisen diese Wert auf einen dynamischen Array . Die Elemente dieser Kollektion werden zunächst als Variante durch VBA definiert. Deswegen mussten wir Dim Elementen als Variant
'Dim arrInOut() As String: ReDim arrInOut(1 To rngSel.Rows.Count, 1 To 2) 'Wir wissen schon große diesem Array und was wir einfühlen wollen,, und es wird gefühlt eine Element nach die andere. Deswegen wir können und dürfen die Passender Dim Typ anweisen schon (Wim musste aber so zu erste machen und dann REDim statt an einfach Dim weil Dim lässt sich nur nummern anweisen, ReDim aber lässt anweisen von variablen
Dim arrIndex() As String 'Wir wissen noch nicht große diesem Array aber wissen was wir einfühlen wollen, und es wird gefühlt eine Element nach die andere. Deswegen wir können und dürfen die Passender Dim Typ anweisen schon (Wir musste aber so zu erste machen und dann danach REDim statt an einfach Dim weil Dim lässt sich nur nummern anweisen, ReDim aber lässt anweisen von variablen
Rem 4 Haupt Schleife. Baut non Duplikat refferences sowie modificieret Input ( OutIn ) Array um zu zeig wenn Unterstrichen
Dim z As Variant, Keys() As Variant 'mit bau von non Duplikat refferences verwenden. Keys wird von anweisen zu eine collection die als Varianten definieret sind. Deswegen, wie beim .Rang.Value mussen wir Typ als Varianten haben
Dim j As Long, i As Long, rOffset As Long: Let rOffset = rngSel.Row - 1
For j = 2 To rngSel.Columns.Count 'Für selektieret Bereich außer erste splaten...
For i = 1 To rngSel.Rows.Count '... schau alle "rows"
'Dieses Mehtode unter =.Item() einfach Art , die uns eindeutige Schlüssel ohne Vergabe Einträge machen zu mussen http://www.snb-vba.eu/VBA_Dictionary_en.html ' -- Normallerweise .Item() verwendet man, um ein Element von eine eindeutiger Schlüssel, .Item, zu einem vaiable zuweisen, bzw. z = dicLookupTable.Item(x(i)) Wenn der Schlüssel aber nicht existiert, dann wird es gemacht - Cool oder ? --- ( Und kein Wert wird in die Variable angegeben werden ( aber das braucht auch Variable typ Variant) )
If arrOutIn(i, j) <> "" And Right(arrOutIn(i, j), 1) <> "U" Then Let z = dicOb.Item(arrOutIn(i, j)) 'man wäre nichts sehen hier in z: Post #7 # 12 #14 http://www.excelforum.com/excel-programming-vba-macros/1083899-copy-and-paste-entire-row-to-second-sheet-based-on-cell-value.html
' vTemp = .Cells(i, j).Font.Underline'Für Debugging Evtl.
If .Cells(i + rOffset, j).Value2 <> "" And .Cells(i + rOffset, j).Font.Underline = 2 Then 'Value 2 ist meist Basiswert und geht schneller, deswegen benutz dieses wenn mogleish
arrOutIn(i, j) = arrOutIn(i, j) & "U" 'Modifizieren falls nummer ist unterstrichen
Else
End If
Next i
Next j
Let Keys() = dicOb.Keys 'Die non Duplikat schlüssel Worte ( Teil Nummer ) ( Unserrere refferences ) can dan von dicOb Eigentschaft bekommen
End With ' wsOutIn
Rem 5 Scleifen um Output Array ( Index ) zu bauern
Dim dI As String, d As Long, stringtemp As String
ReDim arrIndex(1 To dicOb.Count, 1 To 2) 'Wir wissen jetzt nummer von Non Duplicat Referrences Keys(d - 1)
For d = 1 To dicOb.Count 'Für jede Non Duplicat Referrences..
For j = 2 To rngSel.Columns.Count 'Bau string von alle Element in Input Array für dieses refferrence,
For i = 1 To rngSel.Rows.Count
If arrOutIn(i, j) = Keys(d - 1) Then stringtemp = stringtemp & arrOutIn(i, 1) & " "
If arrOutIn(i, j) = Keys(d - 1) & "U" Then stringtemp = stringtemp & arrOutIn(i, 1) & "U "
Next i
Next j
arrIndex(d, 1) = Keys(d - 1): arrIndex(d, 2) = stringtemp 'Wir habe jetzt die string von verketteten Seite Nummern
stringtemp = "" 'Wir wollen diese variablen fürs nächste verketteten Seite Nummern, also soll es jetzt entleeren das wir für diesen Ouput 2row fertig damit sind
Next d
Let wsIn.Range("a1").Resize(UBound(arrIndex(), 1), UBound(arrIndex(), 2)).Value = arrIndex() ''Einfach weg zu fügen Sie Output Array in einem Linie: Ändern Sie die Größe des Bereichs (Zelle) links oben in dem Ausgangsdaten sollte, zu der Größe der Ausgabe-Array, dann verwenden Sie die zulässige VBA "One -Liner " , um die Werte aus einem Array in eine Tabelle Bereich zuordnen zo können
End Sub
LinkBack URL
About LinkBacks
Register To Reply
Originally Posted by Kyle123
- maybe as I am looking in a German version….)
Bookmarks