Avatar billede soeren_soelv Novice
15. maj 2008 - 10:38 Der er 2 kommentarer og
1 løsning

Sammenkædning og summering af data

Jeg har en et dataark med en række maskindata som er listet efter dato og klokkeslæt.

Strukturen er som nedenstående:

Dato  Produktnavn  Fejltype 1  Fejltype 2  Fejltype 3  Forsøg


Det jeg gerne vil trække ud i et nyt ark er en liste med det samlede antal fejl og forsøg for hvert produktnavn pr. dag. Det skal siges at det samme produkt ofte produceres flere gange om dagen.

Ønsket output:

Dato    Produktnavn    Sum Fejl    Sum forsøg


I outputtet skal produktnavnet kun fremgå en gang.
Avatar billede supertekst Ekspert
15. maj 2008 - 13:44 #1
Hvis muligt må gerne sende en kopi af filen - "det letter ekspeditionen" - så skal jeg gøre et forsøg...
(pb@supertekst-it.dk)
Avatar billede soeren_soelv Novice
15. maj 2008 - 14:31 #2
Er sendt.
Avatar billede supertekst Ekspert
15. maj 2008 - 22:57 #3
Rem Version 1
Rem =========
Const optællingsArk = "DATAARK Pareto"
Const dataArk = "DATAARK"

Dim antalRæk, fRække, dArk As Worksheet, optælArk As Worksheet
Sub FejlOptælling()
Dim pNavn, pDato As Date, pMisP, insFail, visionFail, fAtt, fFail

Rem def. ark
    Set dArk = ActiveWorkbook.Sheets(dataArk)
    Set optælArk = ActiveWorkbook.Sheets(optællingsArk)
   
Rem Slet gl. data på optællingsark
    optælArk.Activate
    ActiveSheet.Rows("2:65000").Select
    Selection.Delete Shift:=xlUp

Rem dataArk aktiveres
    dArk.Activate
   
Rem Find antal rækker i arket
    antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
Rem startRække i optællingsarket
    fRække = 2
   
    Application.ScreenUpdating = False
   
Rem Traverser Arket
    For ræk = 2 To antalRæk
        pNavn = Cells(ræk, 1)                                  'A kol

Rem kun beh. hvis pNavn udfyldt
        If pNavn <> "" Then
            pDato = Format(Cells(ræk, 2), "dd-mm-yyyy")            'B -
            pMisP = Cells(ræk, 13)                                  'M -
            insFail = Cells(ræk, 15)                                'O -
            visionFail = Cells(ræk, 16)                            'P -
            fAtt = Cells(ræk, 17)                                  'Q -
            fFail = Cells(ræk, 18)                                  'R -
           
            optælFejl pNavn, pDato, pMisP, insFail, visionFail, fAtt, fFail
        End If
    Next ræk

    Application.ScreenUpdating = True
   
Rem Vis optællingsArk
    optælArk.Activate
    ActiveSheet.Cells(1, 1).Select
   
    MsgBox ("Optælling afsluttet")
End Sub
Private Sub optælFejl(pNavn, pDato, pMisP, insFail, visionFail, fAtt, fFail)
Dim pRæk
    pRæk = findesPnavnPdato(pNavn, pDato)
   
    If pRæk = 0 Then
        pRæk = fRække
        fRække = fRække + 1
    End If
   
    With optælArk
        .Cells(pRæk, 1) = pNavn
        .Cells(pRæk, 2) = pDato
        .Cells(pRæk, 3) = .Cells(pRæk, 3) + pMisP
        .Cells(pRæk, 4) = .Cells(pRæk, 4) + insFail
        .Cells(pRæk, 5) = .Cells(pRæk, 5) + visionFail
        .Cells(pRæk, 6) = .Cells(pRæk, 6) + fAtt
        .Cells(pRæk, 7) = .Cells(pRæk, 7) + fFail
    End With
End Sub
Private Function findesPnavnPdato(pNavn, pDato)
    With optælArk
        For ræk = 2 To fRække
            If LCase(.Cells(ræk, 1)) = LCase(pNavn) And .Cells(ræk, 2) = pDato Then
                findesPnavnPdato = ræk
                Exit Function
            End If
        Next
    End With
    findesPnavnPdato = 0
End Function
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester