Macro's uitschakelen van extern geopend excel document.

Status
Niet open voor verdere reacties.
Hoi Mark,

Als er een waarde in de nieuwe lijst staat welke niet in de oude lijst voorkomt, dan wordt er nog altijd een "0" ingevuld.
Verder werkt het echt super
 
om dat te herstellen verander je
Code: 
    'deel van formule om niets te tonen als er niets is gevonden
    part2 = "IF(OR(NOT(ISBLANK(RC[1])),ISNA(MATCH(RC[2],'[" & lijst_oud.Name & "]" & OUD_BLAD & "'!C2,0))),RC[1],"

in
Code: 
    part2 = "IF(OR(NOT(ISBLANK(RC[1])),ISNA(MATCH(RC[2],'[" & lijst_oud.Name & "]" & OUD_BLAD & "'!C2,0))),RC[1]&"""","

volgens mij werkt het dan naar behoren.
 
Hoi Mark,

Helaas blijf ik de "0" houden.

Ook valt me op dat ondanks de regel:
Code: 
 With ThisWorkbook.Sheets("blad1").Range("A6:A" & einde)

ook A1:A5 wordt overschreven, terwijl dit eigenlijk vaste cellen met inhoud zijn.
 
Luna08 zei:
Ook valt me op dat ondanks de regel:
Code: 
 With ThisWorkbook.Sheets("blad1").Range("A6:A" & einde)

ook A1:A5 wordt overschreven, terwijl dit eigenlijk vaste cellen met inhoud zijn.
Klik om te vergroten...

Dat klopt want die kolom wordt opnieuw opgebouwd en weggegooid

vervang

Code: 
        ThisWorkbook.Sheets("AMS cable overview1").Columns("A").Insert
        
        With ThisWorkbook.Sheets("AMS cable overview1").Range("A6:A" & einde)
            
            .Formula = formule
            .Value = .Value

        End With

        ThisWorkbook.Sheets("AMS cable overview1").Columns("A").Delete
door:
Code: 
        ThisWorkbook.Sheets("AMS cable overview1").Columns("A").Insert
        
        With ThisWorkbook.Sheets("AMS cable overview1").Range("A1:A" & einde)
            
            .Formula = formule
            .Value = .Value

        End With
        
        ThisWorkbook.Sheets("AMS cable overview1").Columns("A").Insert
        
        With ThisWorkbook.Sheets("Blad1").Range("A1:A" & einde)
            
            .Formula = "=IF(RC[1]=0,"""",RC[1])" 'ALS NUL DAN NIKS
            .Value = .Value
        
        End With
        
        ThisWorkbook.Sheets("AMS cable overview1").Columns("A:B").Delete
 
@ Mark
vervolgens vervang ik de formules met waarden met een trucje, zodat je niet copy, pastespecial hoeft te gebruiken, dat scheelt ook weer tijd
Klik om te vergroten...

Nochtans is Copy - PasteSpecial sneller in uitvoering dan .Value = .Value
Doe de test maar eens op een groot bereik met formules. Toen ik dit in een artikel las, kon ik het eerst ook niet geloven, maar na een test was het verschil duidelijk.
 
Aha. dat is wel interessant.

Bedankt voor de tip, dat ga ik zeker uitzoeken!
 
Het verschil kun je echter wel flink verkleinen door Application.calculate op manual te zetten. Copy doet namelijk eerst alle handelingen en doet dan een enkele herberekening.

value = value wordt herberekend per aanroep. Toch blijft copy vaak iets sneller gewoonweg omdat het geimplementeerd is in C++ in excel ipv via de vba interpreter
 
Hoi Mark,

Ik heb de code aangepast echter worden er nu helemaal geen waardes meer ingevuld.
Als ik de regel:

Code: 
ThisWorkbook.Sheets("AMS cable overview1").Columns("A:B").Delete

tijdelijk uitschakel zie ik in kolom A de juiste waarde staan zonder "0'en" en in B met "0'en".
Moet ik nu een regel toevoegen die A kopieert naar C of kan ik hier rechtstreeks heen schrijven?
 
Haha, lekker makkelijk als je niet kan testen

Code: 
 ThisWorkbook.Sheets("AMS cable overview1").Columns("A:B").Delete

moet veranderd worden in
Code: 
 ThisWorkbook.Sheets("AMS cable overview1").Columns("B:C").Delete

want in kolom a staat de juiste data.
nu moet het toch wel in de buurt komen mag ik hopen :)

Goed dat je trouwens de code probeert te begrijpen! das belangrijk om later zelf te bouwen / aan te passen.
 
Laatst bewerkt:
Hoi Mark,

Het werkt nu wel, echter ben ik de vaste waardes in A1:A5 (tijdelijk C1:C5) kwijt...
Dus misschien moet ik toch met een copy functie werken?
 
ok, gebruik je wel deze (dat zou moeten)
Code: 
 With ThisWorkbook.Sheets("AMS cable overview1").Range("A1:A" & einde)

en niet deze: (dat zou niet moeten)
Code: 
 With ThisWorkbook.Sheets("AMS cable overview1").Range("A6:A" & einde)

in allebei de gevallen?
 
Probeer voor de lol deze eens uit op kopieën van je bestanden.
Wijzig de const nog wel in de juiste bladnamen.
Code: 
Sub tst()
Const OUD_BLAD As String = "Blad1"  'de naam van het blad in de werkmap lijst_oud
Const NIEUW_BLAD As String = "AMS cable overview1"  'de naam van het blad in de werkmap lijst_nieuw

Dim lijst_oud As Excel.Workbook, lijst_nieuw As Excel.Workbook
Dim Openfile As Variant, einde As Long, einde2 As Long
Dim sq As Variant, sq2 As Variant
Openfile = Application.GetOpenFilename
If Openfile <> False Then
    Set lijst_oud = Workbooks.Open(Openfile)
    Set lijst_nieuw = ThisWorkbook
    einde = lijst_oud.Sheets(OUD_BLAD).Range("B9999").End(xlUp).Row
    einde2 = lijst_nieuw.Sheets(NIEUW_BLAD).Range("B9999").End(xlUp).Row
    sq = lijst_oud.Sheets(OUD_BLAD).Range("A6:B" & einde) 'Range werkmap oud
    sq2 = lijst_nieuw.Sheets(NIEUW_BLAD).Range("A6:B" & einde2) 'Range werkmap nieuw
    On Error Resume Next
        For i = 1 To UBound(sq2)
            For j = 1 To UBound(sq)
                If sq2(i, 2) = sq(j, 2) Then
                    If sq2(i, 1) = "" Then sq2(i, 1) = sq(j, 1)
                End If
            Next
        Next
    lijst_nieuw.Sheets(NIEUW_BLAD).Range("A6").Resize(UBound(sq2), 2) = sq2
End If
lijst_oud.Close False
End Sub
 
@Mark: dit had ik inderdaad niet goed staan, nu kopieert hij wel de tekst, maar niet de opmaak.
@Rudi::thumb: Dit werkt super (snel). Bedankt!

De code snap ik volgens mij redelijk, alleen weet ik niet wat "unbound" precies doet in
Code: 
 For i = 1 To UBound(sq2)

Wil iemand me dit nog even uitleggen?

PS: allen bedankt voor de hulp
 
Ubound betekent upper bound = maximale dimensie van een matrix

klik het woord aan in de VBA editor en klik op F1. daar staat een uitleg
 
Je maakt gebruik van Ubound als je elk element v/d array wil doorlopen, maar je niet juist weet hoeveel elementen de array bevat.
 
Aha, ok da's duidelijk.
Stel dat ik nu een kolom extra wil kopiëren, eigenlijk zonder voorwaarde.
bijvoorbeeld kolom 5.

Kan ik dan het bereik vergroten door
Code: 
    sq = lijst_oud.Sheets(OUD_BLAD).Range("A6:B" & einde) 'Range werkmap oud
    sq2 = lijst_nieuw.Sheets(NIEUW_BLAD).Range("A6:B" & einde2) 'Range werkmap nieuw

te veranderen in
Code: 
    sq = lijst_oud.Sheets(OUD_BLAD).Range("A6:E" & einde) 'Range werkmap oud
    sq2 = lijst_nieuw.Sheets(NIEUW_BLAD).Range("A6:E" & einde2) 'Range werkmap nieuw

en dan de waarde kopiëren met:
Code: 
sq2(i, 5) = sq(j, 5)

Uiteraard heb ik dit al geprobeerd en werkt het niet :), maar ik snap niet waarom niet.
Ik dacht de code enigszins te begrijpen, valt toch tegen.
 
Je zit op de goede weg, je bent enkel vergeten dat je bij het schrijven van de gegevens je het bereik (lees aantal kolommen) ook moet uitbreiden.
Code: 
Sub tst()
Const OUD_BLAD As String = "Blad1"  'de naam van het blad in de werkmap lijst_oud
Const NIEUW_BLAD As String = "AMS cable overview1"  'de naam van het blad in de werkmap lijst_nieuw

Dim lijst_oud As Excel.Workbook, lijst_nieuw As Excel.Workbook
Dim Openfile As Variant, einde As Long, einde2 As Long
Dim sq As Variant, sq2 As Variant
Openfile = Application.GetOpenFilename
If Openfile <> False Then
    Set lijst_oud = Workbooks.Open(Openfile)
    Set lijst_nieuw = ThisWorkbook
    einde = lijst_oud.Sheets(OUD_BLAD).Range("B9999").End(xlUp).Row
    einde2 = lijst_nieuw.Sheets(NIEUW_BLAD).Range("B9999").End(xlUp).Row
    sq = lijst_oud.Sheets(OUD_BLAD).Range("A6:[COLOR="red"]E[/COLOR]" & einde) 'Range werkmap oud
    sq2 = lijst_nieuw.Sheets(NIEUW_BLAD).Range("A6:[COLOR="red"]E[/COLOR]" & einde2) 'Range werkmap nieuw
    On Error Resume Next
        For i = 1 To UBound(sq2)
            For j = 1 To UBound(sq)
                If sq2(i, 2) = sq(j, 2) Then
                    [COLOR="red"]sq2(i, 5) = sq(j, 5)[/COLOR]
                    If sq2(i, 1) = "" Then sq2(i, 1) = sq(j, 1)
                End If
            Next
        Next
    lijst_nieuw.Sheets(NIEUW_BLAD).Range("A6").Resize(UBound(sq2), [COLOR="red"]5[/COLOR]) = sq2
End If
lijst_oud.Close False
End Sub
Het rode gedeelte heb ik toegevoegd en/of gewijzigd.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan