22. februar 2008 - 09:29Der er
7 kommentarer og 1 løsning
Hente data fra navngiven kolonne i en anden Excel fil.
Hej.
Jeg har et Excel-ark hvor jeg bl.a. skal hente nogle data fra et ark i en anden Excel-fil, de data jeg godt kunne tænke mig at hente ligger i en kolonne (E) som jeg har navngivet som Kundenavn, men jeg kan ikke få dataene med over i hovedet arket, min Visual Basic kode i hovedearket ser sådan her ud:
Private Sub Worksheet_Activate() Application.ScreenUpdating = False Set was = ActiveSheet Set wb = Workbooks.Open("c:\kunder\kunder.xls") For i = 1 To 500 was.Range("R" & i).Value = wb.Sheets(1).Range("E" & i).Value was.Range("N" & i).ClearContents If IsEmpty(wb.Sheets(1).Range("E" & i)) = False Then was.Range("N" & i).Value = wb.Sheets(1).Range("E" & i).Value & "-" & wb.Sheets(1).Range("A" & i).Value & "-" & wb.Sheets(1).Range("K" & i).Value End If Next wb.Close was.Range("N2:R999").Sort _ Key1:=was.Range("R2:R999"), _ Header:=xlGuess Call navnengang Worksheets(1).EnableCalculation = True Application.ScreenUpdating = True
I lang tid har samarbejdsbranchen fokuseret på at forbedre enhedsfunktioner – bedre kameraer, klarere lyd og smartere software. Men den virkelige forvandling handler ikke om funktioner.
Har prøvet at køre en test. Data hentes korrekt over i hovedarket, men Call navnegang var jeg af gode grunde nødt til at REM'. Det skulle vel ikke være i den SUB, at problemet ligger?
Hej, sorry jeg har glemt at vise hvordan min Call navnengang ser ud, her kommer den:
Sub navnengang()
Dim Rng1 As Range Dim rstart1 As Range Dim Cell As Range Dim Uniqs As Object 'New Dictionary
On Error GoTo fejl Set ws = Sheets("UGE (1)") Set rstart1 = ws.Range("R2") Set Rng1 = ws.Range(rstart1.Offset(0, 0), ws.Cells(ws.Rows.Count, rstart1.Column).End(xlUp)) 'Set Rk = ws.Range(startcelle.Offset(0, 0), ws.Cells(ws.Rows.Count, startcelle.Column).End(xlUp))
Set Uniqs = CreateObject("scripting.dictionary") rstart2 = 2 'start række resultat cstart2 = "S" 'kolonne for resultat Application.ScreenUpdating = False On Error Resume Next For Each Cell In Rng1 Uniqs.Add UCase(Cell.Value), CStr(UCase(Cell.Value)) If Err.Number = 0 And Cell.Value <> Empty Then ws.Cells(rstart2, cstart2) = Cell.Value rstart2 = rstart2 + 1 End If Err.Clear Next Cell Application.ScreenUpdating = True Exit Sub fejl: End Sub
Har tilføjet "navnegang" - der kommer du data i kolonne S - men umiddelbart er arket Uge (1) måske ikke det samme som ActiveSheet i 1. halvdel af koden? (Set Was = ActiveSheet)
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.
