VBA zusätzlich eine leere Zeile einführen

[Etoi]

Hallo zusammen ,

vielleicht kann mir ein VBA Kenner kurz weiterhelfen...

Ich habe folgendes Skript und bevor dieses Skript die Daten anfängt einzutragen soll noch eine Zeile frei gelassen werden.

Liebe Grüße und Danke im Voraus :=)

Hier das Skript:

Code:

Sub ImportData_Etzin()

    Dim awsCol As New Scripting.Dictionary
    Dim fzgCol As New Scripting.Dictionary
   
   
    Dim i As Long
    Sheets("Rohdaten").Select
   
   
    For i = 2 To Rows.Count
        Dim value As String
        value = Cells(i, 1).value
       
        If value = "" Then
            Exit For
        End If
       
        Dim team As String
        Dim konto As String
        Dim aw As Integer
        Dim fzg As Integer
        Dim datum As String
        Dim key As String
       
        team = Cells(i, 1).value
        konto = Replace(Cells(i, 2).value, "0", "")
        konto = IIf(konto = "41", 410, konto)
        konto = IIf(konto = "42", 420, konto)
        konto = IIf(konto = "46", 460, konto)
        aw = Cells(i, 3).value
        fzg = Cells(i, 4).value
        datum = Cells(i, 9).value
       
        key = team + "|" + konto + "|" + datum
       
        If Not awsCol.Exists(key) Then
            awsCol.Add key, 0
            fzgCol.Add key, 0
        End If
       
        awsCol.Item(key) = awsCol.Item(key) + aw
        fzgCol.Item(key) = fzgCol.Item(key) + fzg
       
    Next i

    Sheets("Daten").Select
   
    For i = 2 To Rows.Count
        If Cells(i, 1).value = "" And Cells(i + 1, 1).value = "" And Cells(i + 2, 1).value = "" Then
            Exit For
        End If
    Next i
   
   
   
    For Each v In awsCol.Keys
        Dim splits() As String
        splits = Split(v, "|")
       
        Dim teamKey As String
        teamKey = splits(0)
       
        teamKey = IIf(splits(0) = "ND", "N", teamKey)
        teamKey = IIf(splits(0) = "Dai", "D", teamKey)
        teamKey = IIf(splits(0) = "Mos", "M", teamKey)
        teamKey = IIf(splits(0) = "For K", "K", teamKey)
        teamKey = IIf(splits(0) = "S&", "S", teamKey)
        teamKey = IIf(splits(0) = "Ber", "B", teamKey)
        teamKey = IIf(splits(0) = "Ege", "E", teamKey)
        teamKey = IIf(splits(0) = "Car", "C", teamKey)
       
        Cells(i, 1).value = teamKey
        Cells(i, 2).value = splits(1)
        Cells(i, 12).value = splits(2)
        Cells(i, 7).value = awsCol.Item(v)
        Cells(i, 6).value = fzgCol.Item(v)
       
        i = i + 1
    Next
   
    MsgBox ("Fertig")
   
End Sub

[Steffl]

Hallo,

beim zweiten For i = 2 ändere es so ab

Code:

For i = 3 To Rows.Count

[Etoi]

Guten Morgen :)

habe es gerade abgeändert aber leider lässt er bevor er die neuen Daten einfügt keine Zeile frei :( .. muss ich mehr machen außer i=3 setzten?

Grüße  und vielen lieben dank im Voraus :)

[Wastl]

Guten Morgen,

prinzipiell kann man mit der Taste F8 das makro schritt für schritt laufen lassen, und dabei gleichzeitig beobachten wann was passiert.
Da ich nur das VBA von dir habe, tippe ich mal darauf dass du beide 
For i = 2
durch 
For i = 3
ersetzen musst.

mach das und kontrolliere mit F8 = Makro Einzeleschritt, ob das tut wie gewünscht.

Wenn nein, poste mal, was in Zeile 2 deiner Tabelle Daten schreibt.

[chris-ka]

Hi,

ein etwas eigener Algorithmus ;)  der in Verwendung ist.
füge zwischen
 
    Next i
   
    i=i+1 'das hier ein
   
    For Each v In awsCol.Keys

[Kuwer]

Hallo Etoi,

teste mal so:

Sub ImportData_Etzin()

    Dim awsCol As New Scripting.Dictionary
    Dim fzgCol As New Scripting.Dictionary
    Dim i As Long
    Dim team As String
    Dim konto As String
    Dim aw As Integer
    Dim fzg As Integer
    Dim datum As String
    Dim key As String
    Dim splits() As String
    Dim teamKey As String
    
    With Sheets("Rohdaten")
        For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            team = .Cells(i, 1).Value
            konto = Replace(.Cells(i, 2).Value, "0", "")
            Select Case konto
                Case 41, 42, 46
                    konto = konto * 10
            End Select
            aw = .Cells(i, 3).Value
            fzg = .Cells(i, 4).Value
            datum = .Cells(i, 9).Value
            
            key = team + "|" + konto + "|" + datum
            
            If Not awsCol.Exists(key) Then
                awsCol.Add key, 0
                fzgCol.Add key, 0
            End If
            
            awsCol.Item(key) = awsCol.Item(key) + aw
            fzgCol.Item(key) = fzgCol.Item(key) + fzg
        Next i
    End With
    With Sheets("Daten")
        i = .Cells(.Rows.Count, 1).End(xlUp).Row + 2
        
        For Each v In awsCol.Keys
            splits = Split(v, "|")
            
            teamKey = splits(0)
            
            teamKey = IIf(splits(0) = "ND", "N", teamKey)
            teamKey = IIf(splits(0) = "Dai", "D", teamKey)
            teamKey = IIf(splits(0) = "Mos", "M", teamKey)
            teamKey = IIf(splits(0) = "For K", "K", teamKey)
            teamKey = IIf(splits(0) = "S&", "S", teamKey)
            teamKey = IIf(splits(0) = "Ber", "B", teamKey)
            teamKey = IIf(splits(0) = "Ege", "E", teamKey)
            teamKey = IIf(splits(0) = "Car", "C", teamKey)
            
            .Cells(i, 1).Value = teamKey
            .Cells(i, 2).Value = splits(1)
            .Cells(i, 12).Value = splits(2)
            .Cells(i, 7).Value = awsCol.Item(v)
            .Cells(i, 6).Value = fzgCol.Item(v)
            
            i = i + 1
        Next v
    End With
    MsgBox ("Fertig")
End Sub

Gruß Uwe

[Etoi]

Danke chris-ka mit der Methode i+1 hat es geklappt :)

Grüße und dank an alles :)