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 :)