Hallo,
ich habe folgende Datengrundlage:
http://www42.zippyshare.com/v/37758364/file.html
Ich bastel nun an einem Makro, welches mir die "Blöcke" angleicht. In diesen Blöcken fehlen entweder zwei oder nur eine Zeile, die immer gleich sind:
Block 1: a,b,c,d,e,f,g
Block 2: a,b,c,d,e,f
Block 3: a,b,c,d,e
Die Logik habe ich soweit fertig (aber nicht getestet). Ich weiß leider nicht, wie ich die Zeilen nun einfügen kann.
Option Explicit
Sub sss()
Dim suchArray(1 To 9) As String
Dim z As Variant
Dim w, x, y As Long
Dim wksQuelle As Excel.Worksheet
Dim rngQuelle As Excel.Range
Dim a As Long
Dim zaehler As Long
Dim objArrLst As Object
Set objArrLst = CreateObject("System.collections.arraylist")
Set rngQuelle = wksQuelle.UsedRange
Set x = 1
End Sub
'Schleife für max Zeilen
While x <> rngQuelle
'Schleife zur Befüllung des Arrays
'Zaehlvariablen zurücksetzen
Set w = 1
Set zaehler = 0 'Zaehler kann maximal 2 sein
'Befüllen des Arrays mit neun Werten
For y = x To x + 9
'Speichern des Wertes in Spalte E
suchArray(w) = z(b, e)
Next y
'Durchsuchen nach doppelten Werten
For a = 0 To UBound(suchArray) - 1
If objArrLst.Contains(suchArray(a)) = False Then
objArrLst.Add suchArray(a)
Else
zaehler = zaehler + 1
End If
Next
'Einfügen der neuen Zeilen innerhalb des Arrays
If zaehler = 2 Then
'zwei Zeilen einfügen mit Inhalte Spalte A und B von Zelle drüber
'Spalte C und E ein bestimmter String pro Zeile (bsp zeile1 und zeile 2)
'Spalte D und F 0
ElseIf zaehler = 1 Then
'nur eine Zeile einfügen (zeile1) wie oben
End If
'#nächster Block
x = x + 9
Set objArrLst = Nothing
Erase suchArray
Wend
Für Hilfe wäre ich sehr dankbar!
|