Bekijk de onderstaande video om te zien hoe je onze site als een web app op je startscherm installeert.
Opmerking: Deze functie is mogelijk niet beschikbaar in sommige browsers.
'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],"
part2 = "IF(OR(NOT(ISBLANK(RC[1])),ISNA(MATCH(RC[2],'[" & lijst_oud.Name & "]" & OUD_BLAD & "'!C2,0))),RC[1]&"""","
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.
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
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
vervolgens vervang ik de formules met waarden met een trucje, zodat je niet copy, pastespecial hoeft te gebruiken, dat scheelt ook weer tijd
ThisWorkbook.Sheets("AMS cable overview1").Columns("A:B").Delete
ThisWorkbook.Sheets("AMS cable overview1").Columns("A:B").Delete
ThisWorkbook.Sheets("AMS cable overview1").Columns("B:C").Delete
With ThisWorkbook.Sheets("AMS cable overview1").Range("A1:A" & einde)
With ThisWorkbook.Sheets("AMS cable overview1").Range("A6:A" & einde)
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
For i = 1 To UBound(sq2)
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
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
sq2(i, 5) = sq(j, 5)
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
We gebruiken essentiële cookies om deze site te laten werken, en optionele cookies om de ervaring te verbeteren.