Avatar billede soeren_soelv Novice
16. maj 2008 - 14:28 Der er 2 kommentarer og
1 løsning

Sammenkædning og summering af data

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

Strukturen er som nedenstående:

Dato    Komponentnavn    Fejltype 1    Fejltype 2    Fejltype 3    Komponentnavn    Fejltype 1    Fejltype 2    Fejltype 3    Komponentnavn    Fejltype 1    Fejltype 2    Fejltype 3 …

Det jeg gerne vil trække ud i et nyt ark er en liste med det samlede antal fejl for hvert komponentnavn pr. dag. Der kan fremkomme maks. 15 komponenter pr. række

Ønsket output:

Dato    komponentnavn    Sum Fejl
Avatar billede supertekst Ekspert
16. maj 2008 - 15:42 #1
Rem Version 2 - optælling pr. PartName
Rem ==================================
Const optællingsArk = "DATAARK Pareto"
Const dataArk = "DATAARK"

Dim antalRæk, fRække, dArk As Worksheet, optælArk As Worksheet, del2Start
Sub PartsOptælling(slutRæk)
Dim pNavn, pDato As Date, pMisP, insFail, visionFail
Dim kol

    del2Start = slutRæk
   
Rem def. ark
    Set dArk = ActiveWorkbook.Sheets(dataArk)
    Set optælArk = ActiveWorkbook.Sheets(optællingsArk)
       
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 = del2Start
   
    Application.ScreenUpdating = False
   
Rem Traverser Arket pr række i range X - CE
   
    For ræk = 2 To antalRæk
        kol = Range("X2").Column
   
        For x = 1 To 15
            pNavn = Cells(ræk, kol)                                    'PartName kol

Rem afbryd række, hvis pNavn er ej udfyldt
            If pNavn = "" Then
                Exit For
            End If
           
            pDato = Format(Cells(ræk, 2), "dd-mm-yyyy")            'B -
            pMisP = Cells(ræk, kol + 1)                            'MisPicked
            insFail = Cells(ræk, kol + 2)                          'Ins Fail.
            visionFail = Cells(ræk, kol + 3)                        'Vision Fail.
           
            optælFejl pNavn, pDato, pMisP, insFail, visionFail
            kol = kol + 4
        Next x
    Next ræk

    Application.ScreenUpdating = True
End Sub
Private Sub optælFejl(pNavn, pDato, pMisP, insFail, visionFail)
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
    End With
End Sub
Private Function findesPnavnPdato(pNavn, pDato)
    With optælArk
        For ræk = del2Start 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 znogen Nybegynder
17. maj 2008 - 22:09 #2
sikke en kode, kan en simpel pivottabel ikke klare det?
Avatar billede soeren_soelv Novice
18. maj 2008 - 00:19 #3
Sikkert. Hvor finder jeg den og hvordan benyttes den?
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