Avatar billede Helga Novice
17. marts 2017 - 13:44

VB til at finde matchen og flette to projektmappe

Beskrivelse: der er to projektmapper, hvor en af dem bruges som hoved-fil med det oprindelige datasæt og den anden af dem svarer til opdateringer på det oprindelige data (rækkerne i de to projektmapper matcher ikke hinanden og ikke i en bestem rækkefølge). Hovedfilen er på størrelsen i A1:L, hvor den første række står for navner. Opdateringsfilens data ligger i området: A1:Q, hvor den første række igen svarer til kolonnens navner.
I kolonnen D af opdateringsfilen står der varer nummer som findes i kolonnen G af hovedfilen (i ubestemt rækkefølge).
I kolonnen Q af opdateringsfilen står der tre kriterier: pris, tekst, tekst og pris.
I kolonnen B af opdateringsfilen står der to kriterier: delete og update.

Opgavetrin:
Makroen finder en match mellem de to kolonnen D i opdateringsfilen og kolonnen G i hovedfilen.
Makroen tjekker kolonnen B værdi:
hvis der står delete, så sætter makroen i den tilsvarende celle (samme række) i kolonnen L af hovedfilen datoværdi (som er defineret i variablen: vDato).
Hvis der står update, så går makroen til den tilsvarende celle (samme række) i kolonnen Q af opdateringsfilen og kør baseret på
        Hvis værdien er tekst, så gør ikke noget (exit)
Hvis værdien er pris eller tekst og pris, så tilføres en række i hovedbladet lige efter den matchende varer nummer og kopieres værdien af prisen fra kolonnen O af opdateringsfanebladet til cellen i kolonnen I (af hovedbladet).

Problemstilling:
efter gennemkørsel ender makroen 1 med at signalere om "ingen kriterier opfyldte match-kriterier" og ifølge coden indsætter bare et tomt Excel ark.
makroen 2 køres men igen uden en synlig eneste ændring.
Coden vil meget gerne blive flytte til et array da det giver et højere hastighedsniveau.


Makro1 code:

Sub OpdatereArkEfterNyInfo()
'makroen

Dim i As Long, j As Long, lCol As Long, X As Long
Dim opdTabel As Variant, hovTabel As Variant
Dim arOutputUp(), arOutputH()
Dim vDato As Variant, Varer As Variant, PrisTekst As Variant

vDato = InputBox("Angiv opdateringsdatoen", "Identifikator")
If Len(vDato) = 0 Then Exit Sub

opdTabel = Sheets("update").Range("A1").CurrentRegion
(opdTabel)) 'indsætte array 1 fra opdateringsdatafilen
hovTabel = Sheets("Compliance2").Range("A1").CurrentRegion


X = 1
    For i = 2 To UBound(opdTabel)
        For j = 2 To UBound(hovTabel)
          If (opdTabel(i, 4) = hovTabel(j, 7)) Then ' hvis varer nr. i opdat.arryet er lig med vare nr. i hov.arrayet
                If (opdTabel(i, 2) = "delete") Then 'tjekker værdien i col.L i opdat.arrayet
                hovTabel(j, 12) = vDato ' hvis ja, indsætter vDato værdien i hov.arrayet
                  If (opdTabel(i, 2) = "update") Then ' hvis nej, går til at tjekke værdier i kol.Q i opdat.arrayet
                        If (opdTabel(i, 17) = "tekst") Then ' hvis værdien er tekst, gør ikke noget
                        Exit For
                            If (opdTabel(i, 17) = "pris") Or (opdTabel(i, 17) = "Tekst og pris") Then ' hvis værdien er pris eller tekst og pris,
                            Rows(i).EntireRow.Insert ' tilførelsen af en række i hov.arrayet lige efter den opfundet varer nr.- dog VIRKER IKKE
                            hovTabel(j + 1, 9) = opdTabel(i, 15) And vDato = hovTabel(j + 1, 11) 'indsæt den opdateret pris og vDato i de angivende celler i hovedarrayet
                                For lCol = 1 To UBound(hovTabel)
                                    arOutputH(X, lCol) = hovTabel(i, lCol)
                                Next
                                X = X + 1 'jeg er i tvivl hvorvidt jeg skal tilføre flere tællere dvs. efter hver betingelse og ændrer min arOutputH arrayet hver gang?
                            End If
                        End If
                    End If
                End If
          End If
        Next
    Next


If X = 1 Then
MsgBox "Ingen rækker opfyldte match-kriterier"
End If

Worksheets.Add.Name = "test"
Range("A1").Resize(UBound(arOutputH), UBound(arOutputH, 2)) = arOutputH ' i hvirkelighed vil jeg gerne ændre min oprindelige tabel i Compliance_2
' dette er for at ikke ødelægge data - i virkelighed skal outputen efter arrayet manipulation sættes i Compliance2 - projektmappen.

End Sub

Makro 2 code:

Public Sub OpdatereDataBaseretPåVareNr()

    'makroen køres, dog kan jeg ikke opfinde ændringer i datoen som skal være med i.
    Dim Updatedata As Variant, Compliance2data As Variant, i As Long, j As Long
    Dim vDato As Variant
   
    vDato = InputBox("Angiv opdateringsdatoen", "Identifikator")
    If Len(vDato) = 0 Then Exit Sub

    Updatedata = Sheets("update").Range("A1:Q" & Sheets("update").Range("A1").CurrentRegion.Rows.Count)
    Compliance2data = Sheets("Compliance2").Range("A1:N" & Sheets("Compliance2").Range("A1").CurrentRegion.Rows.Count)
   
   
    For i = 2 To UBound(Updatedata)
        For j = 2 To UBound(Compliance2data)
            If (Compliance2data(j, 4) = Updatedata(i, 7) And Updatedata(i, 2) = "delete") Then  ' hvis den findes og kol.Q værdien er "delete",så
                Compliance2data(j, 12) = vDato 'indsæt bruger-defineret-Vdato i Compliance2
                If (Compliance2data(j, 4) = Updatedata(i, 7) And Updatedata(i, 2) = "update" And Updatedata(i, 17) = "tekst") Then 'hvis den findes og kol.B værdien er "update" og kol.G er "tekst"
                        Exit For ' foretager ikke noget
                            If (Compliance2data(j, 4) = Updatedata(i, 7) And Updatedata(i, 2) = "update" And Updatedata(i, 17) = "pris" Or Updatedata(i, 17) = "Tekst og pris") Then  ' hvis værdien er pris eller tekst og pris,
                              Sheets("Compliance2").Range("A:Q" & Sheets("Compliance2").Range("A:Q").CurrentRegion.Rows.Count + 1) = Updatedata(i, 1) 'prøvede at finde en "mellem-løsning" og indsætter
                            End If ' den opdaterede data til sidst i tabellen
                End If
          End If
        Next
    Next
   

End Sub
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

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