Hente data i ekstern fil
JEg har nu et regneark med arkene:nykontoplan
import
konto
I arket "nykontoplan" står der nogle linier i kol. A et nr. i (feks. 1000 eller 1010 eller 1015 osv.
I kollonnerne B-O står der også nogle oplysninger, men det er tallet i kol. A der er afgørende.
I arket "Import" står der ligeledes tal i kollonne A. Tallene i kolonne varier tit.
Jeg har en makro der kontrollerer om der er en linie i arket "nykontoplan" der har samme nummer/tal som alle linierne i arket "import".
SE MAKRO 1 NEDENFOR
Makroen tjekker om der er overensstemmelse mellem de to ark.
Nu vil jeg gerne have en makro der henter data i en ekstern fil, hvis der IKKE er overensstemmelser. Ellers skal den ingenting gøre.
Jeg har allerede en makro der kan hente den tingene som det skal
SE MAKRO 2 NEDENFOR
Men den henter jo ikke i en ekstern fil.
Jeg har en makro der åbner op for at hente data i eksterne filer.
SE MAKRO 3 NEDENFOR
.....men jeg kan ikke finde udaf af kombinere tingene så det kan løse mine problemstillinger.
Er der nogen der har mod på at løse mit kringlede problem?
***** MAKRO 1 *****************************
Public Sub HentKonto()
Dim Data As Variant, Data1 As Variant, Poster() As Variant, I As Long, X As Integer
Dim Antal As Long, K As Long
With Worksheets("konto")
Application.ScreenUpdating = False
RW = .Range("A7000").End(xlUp).Row + 1
Data = .Range("A5:O" & RW) ' variabel med tal
Data1 = .Range("A5:O" & RW).Formula ' variabel med formler
End With
Antal = UBound(Data, 1)
On Error Resume Next
For I = 1 To UBound(Data, 1)
If Data(I, 3) = 0 And Data(I, 5) = 0 Then
Data(I, 1) = Empty
Antal = Antal - 1
End If
Next
ReDim Poster(Antal, UBound(Data, 2) - 1)
K = 0
For I = 1 To UBound(Data, 1)
If Not IsEmpty(Data(I, 1)) Then
For X = 1 To UBound(Data, 2) - 1
Poster(K, X - 1) = Replace(Data1(I, X), I + 4, K + 5)
Next
K = K + 1
End If
Next
With Worksheets("ark1") ' ret til det ark du vil have det i
.Range(Range("A5"), ActiveCell.SpecialCells(xlLastCell)).ClearContents
.Range("A5").Resize(UBound(Poster, 1), UBound(Poster, 2)) = Poster
End With
Application.ScreenUpdating = True
End Sub
http://www.eksperten.dk/spm/796481
***** MAKRO 2 **************************************
Sub Check()
Set sh1 = Sheets("Ark1")
Set sh2 = Sheets("Ark2")
r1 = sh1.Cells(65500, 1).End(xlUp).Row
r2 = sh2.Cells(65500, 1).End(xlUp).Row
x = 0
For t = 1 To r1
x = 0
For tt = 1 To r2
If sh2.Cells(tt, 1) = sh1.Cells(t, 1) Then x = 1: Exit For
Next
If x = 0 Then y = y & sh1.Cells(t, 1) & vbLf
Next
MsgBox ("Der mangler") & vbLf & y
End Sub
http://www.eksperten.dk/spm/796550
***** MAKRO 3 ******
Sub importer_kontoplanen()
If MsgBox("Er du sikker på at du vil importere data fra en anden fil?", vbOKCancel, "Advarsel!") = vbCancel Then Exit Sub
Dim fn As Variant
ChDrive "d"
ChDir "d:\"
fn = Application.GetOpenFilename("Excel-files,*.xls", 1, "Vælg sidste års fil", , False)
If TypeName(fn) = "Boolean" Then Exit Sub
' the user didn't select a file
Debug.Print "Selected file: " & fn
If MsgBox("Du har valgt at importere data fra filen:" & vbLf & vbLf & fn & vbLf & vbLf & "Er du sikker på at du vil fortsætte?", vbOKCancel, "Advarsel!") = vbCancel Then Exit Sub
'Workbooks.Open fn
Dim wb As Workbook
' Application.ScreenUpdating = False ' turn off the screen updating
Set wb = Workbooks.Open(fn, True, True)
'importer alle oplysninger fra stamoplysninger
With ThisWorkbook.Worksheets("stam")
.Range("type").Formula = wb.Worksheets("stam").Range("type").Formula
.Range("nr").Formula = wb.Worksheets("Stam").Range("nr").Formula + 1
' osv.....
' osv.....
' osv.....
' osv.....
' osv.....
End With
wb.Close False ' close the source workbook without saving any changes
Set wb = Nothing ' free memory
Application.ScreenUpdating = True ' turn on the screen updating
MsgBox "Importen er færdig!"
End Sub
