23. juli 2014 - 21:59Der er
8 kommentarer og 1 løsning
Under VBA kodeafvikling viser navnelinjen øverst Filnavn (Svarer ikke)
Gode eksperter, råd søges. Jeg har lavet en VBA-kode, som sammenligner data i et gammelt regneark med data i et nyt opdateret regneark, for at finde ændringer som skal bearbejdes yderligere. Jeg har koden i et Macro regneark, de gamle data i gl.xlsx og det reviderede regneark i ny.xlsx. Koden virker perfekt, den finder afvigelserne og markerer dem med den fyldfarve jeg har valgt, ikke markerede celler er ens i de 2 regnearks udgaver. Det virker fint ved 1.000, 37.000 og 150.000 celler til sammenligning. Tidsmæssigt tager det på min Pc 10 sekunder, 8 minutter og 27 minutter. Ved de 2 store regneark kommer der efter nogle minutters kørsel tilføjelsen(Svarer ikke) til filnavnet i navnelinjen øverst. Indtil nu har programmet kørt koden til ende og meddeler i en Tekstboks at "Jobbet er afsluttet". Dvs. teksten (Svarer ikke) velsagtens kun fortæller, at programmet ikke kan klare flere opgaver lige nu. Det kan godt være ok. Men det kan være svært at afvente kodeafviklingen når teksten (Svare ikke) skinner i øjnene. Er det muligt at kode en Tekstboks der siger " Program fejl" hvis programafvikling af en eller anden grund går 'død' og programmet stopper?.
Ja, her er den. Opgaven er at sammenligne hver enkelt sammenlignelig celle i gl. ark med ny ark. Da en revision kan medføre tilføjelse (sletning) af en række eller kolonne i det reviderede regneark, har jeg brugt KolonneOverskrift / RækkeOverskrift som cellereferencer i stedet for "D52". Under afgrænsning af data området farvefyldes cellerne. Denne fyldfarve fjernes derefter for hver celle som har ens dataværdier på gl. og ny ark. Afvigende celler farves gule, så de hurtigt kan findes visuelt, og bearbejdes. Jeg håber at min 'hobby'kodning er til at forstå. Hilsen Henry
Dim adrR, adrC, adrRny As Variant Dim dataC, dataR, dataK As Variant Dim rk1, rk2, kol1, kol2, kol3, nr, tæl1, tæl2, tæl3, tæl4, celf, _ nyk, nyr, glk, glr, nykf, glkf, nyrf, glrf As Integer Dim fv, vf1 As Object
' antal kolonner [A1].Select kol1 = ActiveCell.Column rk1 = ActiveCell.Row tæl1 = 1 tæl2 = 1 Do Until ActiveCell.Offset(0, 1).Value = "" And ActiveCell.Offset(0, 2).Value = "" _ And ActiveCell.Offset(0, 3).Value = "" And ActiveCell.Offset(0, 4).Value = "" _ And ActiveCell.Offset(0, 5).Value = "" ActiveCell.Offset(0, 1).Select tæl1 = tæl1 + 1 Loop kol2 = ActiveCell.Column [A1].Select 'antal rækker Do Until ActiveCell.Offset(1, 0).Value = "" And ActiveCell.Offset(2, 0).Value = "" _ And ActiveCell.Offset(3, 0).Value = "" And ActiveCell.Offset(4, 0).Value = "" _ And ActiveCell.Offset(5, 0).Value = "" ActiveCell.Offset(1, 0).Select tæl2 = tæl2 + 1 Loop rk2 = ActiveCell.Row Range(Cells(rk1, kol1), Cells(rk2, kol2)).Select Selection.Interior.Color = fv [B2].Select
End Sub
Sub e_kol_overskrift()
Windows("gl.xlsx").Activate tæl1 = 0 [A1].Select Do Until tæl1 = glk tæl1 = tæl1 + 1 adrC = ActiveCell.Address dataC = ActiveCell.Value Windows("ny.xlsx").Activate [A1].Select tæl2 = 1 Do Until ActiveCell.Value = dataC Or tæl2 = nyk tæl2 = tæl2 + 1 ActiveCell.Offset(0, 1).Select Loop
If ActiveCell.Value = dataC Then Selection.Interior.Pattern = xlNone nykf = nykf - 1 Windows("gl.xlsx").Activate Range(adrC).Select Selection.Interior.Pattern = xlNone glkf = glkf - 1 GoTo næste Else: Windows("gl.xlsx").Activate Range(adrC).Select næste: ActiveCell.Offset(0, 1).Select End If Loop
ActiveWindow.LargeScroll ToRight:=-2 [A1].Select Windows("ny.xlsx").Activate ActiveWindow.LargeScroll ToRight:=-2 [A1].Select Windows("gl.xlsx").Activate End Sub
Sub f_data()
' find rækker med same overskrift [A1].Select tæl1 = 0 celf = 0 Do Until tæl1 = glr ActiveCell.Offset(1, 0).Select tæl1 = tæl1 + 1 adrR = ActiveCell.Address dataR = ActiveCell.Value Windows("ny.xlsx").Activate [A2].Select tæl4 = 1 Do Until ActiveCell.Value = dataR Or tæl4 = nyr + 5 ActiveCell.Offset(1, 0).Select tæl4 = tæl4 + 1 Loop If ActiveCell.Value = dataR Then adrRny = ActiveCell.Address ElseIf tæl4 = nyr + 5 Then glrf = glrf + 1 GoTo rækkemangler End If g_kolonner
Sub g_kolonner() 'find kolonner på rækken gl/ny Windows("gl.xlsx").Activate Range(adrR).Select tæl2 = 0 Do Until tæl2 = glk tæl2 = tæl2 + 1 rk1 = ActiveCell.Row - 1 adrC = ActiveCell.Address dataC = ActiveCell.Value dataK = ActiveCell.Offset(-rk1, 0).Value Windows("ny.xlsx").Activate Range(adrRny).Select tæl3 = 1 rk2 = ActiveCell.Row - 1 Do Until ActiveCell.Offset(-rk2, 0).Value = dataK Or tæl3 = nyk + 5 ActiveCell.Offset(0, 1).Select tæl3 = tæl3 + 1 Loop 'datakontrol
If tæl3 = nyk + 5 Then nr = 0 GoTo kolonnemangler End If kol3 = ActiveCell.Column If kol3 = 1 Then kol3 = 0 Else: kol3 = kol3 - 1 End If If ActiveCell.Offset(-rk2, 0).Value = dataK And ActiveCell.Value = dataC _ And ActiveCell.Offset(0, -kol3).Value = dataR Then Selection.Interior.Pattern = xlNone nr = 1 ElseIf ActiveCell.Offset(-rk2, 0).Value = dataK And ActiveCell.Offset _ (0, -kol3).Value = dataR Then Selection.Interior.Color = fv 'gul nr = 0 End If Range(adrRny).Select kolonnemangler: Windows("gl.xlsx").Activate Range(adrC).Select If nr = 1 Then Selection.Interior.Pattern = xlNone ElseIf nr = 0 And tæl3 = nyk + 5 Then GoTo næste Else: Selection.Interior.Color = fv 'gul celf = celf + 1
næste: End If ActiveCell.Offset(0, 1).Select Loop End Sub
Her i den næste er alle select væk og data behandles i hukommelsen.
Sub D_Afgrænse() Dim DataKol As Variant, DataRow As Variant, I As Long kol1 = 1 rk1 = 1 tæl1 = 1 tæl2 = 1
' antal kolonner DataKol = Rows("1:1") ' kolonner For I = 1 To UBound(DataKol, 2) If IsEmpty(DataKol(1, I + 1)) And IsEmpty(DataKol(1, I + 2)) And IsEmpty(DataKol(1, I + 3)) _ And IsEmpty(DataKol(1, I + 4)) And IsEmpty(DataKol(1, I + 5)) Then Exit For End If Next kol2 = I
'antal rækker DataRow = Columns("A:A") ' rækker For I = 1 To UBound(DataRow, 1) If IsEmpty(DataRow(I + 1, 1)) And IsEmpty(DataRow(I + 2, 1)) And IsEmpty(DataRow(I + 3, 1)) _ And IsEmpty(DataRow(I + 4, 1)) And IsEmpty(DataRow(I + 5, 1)) Then Exit For End If Next rk2 = I Range(Cells(rk1, kol1), Cells(rk2, kol2)).Interior.Color = fv
Hej Kabbak, tak for dit input. Jeg er ikke i tvivl om, at mit kodesprog er svær at læse. Jeg er selvlært 'klamphugger' i det her. Men jeg synes det er sjovt, og kender en der har spændende opgaver og meget glæde af det jeg 'får banket sammen'. Jeg vil suge din kode til mig, og håbe på, at jeg engang kan skrive ligeså effektivt. Jeg har lige prøvet din Sub D_Afgrænse() men kan ikke for godt gennemskue den og f.eks. ikke se at den tæller antal kolonner og rækker. De tal har jeg brugt til at trække 1 fra hver gang en kolonne- eller rækkeoverskrift er ens på de 2 ark. Derved har jeg fået en restsum som er = kolonne-række-fejl fra gl. til ny. Men de rigtige områder er farvelagt. Kan du anbefale mig en bog, som kan hjælpe mig til en mere struktureret forståelse af VBA programmering i Excel? Du og andre eksperter har gennem en del år givet mig mange gode ideer til løsning af meget forskelligartet kode. Det har jeg været rigtig glad for. Hilsen
Må jeg få et svar på, om VBA kode kan fortælle mig om Excel er stoppet ? Når jeg kører min kode kommer teksten (Svarer ikke)i titel linjen, men Excel færdiggør jo alligevel VBA programmet.
Jeg ser også tit det med at '(Svarer ikke), men jeg mener ikke at det kan fanges via VBA, jeg tror ikke det er selve Excel der skriver det, men måske styresystemet, jeg venter altid indtil jeg mener at det har taget for lang tid med den opgave man satte programmet på, inden jeg afbryder.
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.
