Clever-Excel-Forum

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

Hallo,

beim zweiten For i = 2 ändere es so ab

Code:
For i = 3 To Rows.Count

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

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.

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

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

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

Grüße und dank an alles :)

Etoi

Steffl

Etoi

Wastl

chris-ka

Kuwer

Etoi