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 dette særtema ser vi på, hvordan cloud og AI bliver fundamentet for virksomhedernes digitale forretning, og hvordan de nye muligheder for automatisering og forretningsværdi kan udnyttes uden at miste overblik, sikkerhed og menneskelig kontrol.
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.