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