Results 1 to 9 of 9

Thread: Editor Formating Test

Hybrid View

Previous Post Previous Post   Next Post Next Post
  1. #1
    Junior Member
    Join Date
    Oct 2012
    Posts
    4
    Rep Power
    0
    Code:
    '
    '
    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

  2. #2
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,521
    Rep Power
    10
    Welcome to The Board Kyle,
    . May your extension come out as colorful here as in Other Forums
    . Thankyou for Getting it out here for us to play with
    Alan

    P.s. That's a Geil code you have there

    P.s. Wierd to see you decribed as a Member
    Last edited by DocAElstein; 09-01-2015 at 08:26 PM. Reason: Kyle is a Member and extended his tool to bring it out here. OOh Er Misus!!

Similar Threads

  1. This is a test Test Let it be
    By Admin in forum Test Area
    Replies: 6
    Last Post: 05-30-2014, 09:44 AM
  2. Test
    By Excel Fox in forum Den Of The Fox
    Replies: 0
    Last Post: 07-31-2013, 08:15 AM
  3. Copying formulas while keeping formating
    By Bradh in forum Excel Help
    Replies: 1
    Last Post: 12-02-2012, 11:32 AM
  4. VBA editor auto-deletes spaces at the ends of lines
    By LalitPandey87 in forum Excel Help
    Replies: 0
    Last Post: 06-26-2012, 07:53 PM
  5. Test
    By Excel Fox in forum Word Help
    Replies: 0
    Last Post: 07-05-2011, 01:51 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •