Hvordan kan jeg lave en 'normal' database af disse data??

Hvor kommer data fra?
Er det ikke muligt at konvertere til andre formater fra det program data kommer fra?

Nej, jeg kan vælge mellem lotus, structured text og tab-text. Ved lotus og tab ser det godt ud, men jeg får kun forfatter, titel, emnekode og idnummer med. Structured, så ser den ud som book1.

det er fra et hjemmelavet program, der eksportes

Det kan jo være, jeg må nøjes med færre data, hvis det ikke kan fikses.

(svarer først på evt. indlæg i aften)

Filen kan hentes ind i Word, og tilrettes så den kan åbnes som komma(semikolon)-separeret fil i Excel.

Men det næste problem er så, at der ikke er lige mange felter for hver post, og at der er ledetekst med for hvert eneste felt.

Er det noget, der skal konverteres en gang for alle, eller er det en tilbagevendende opgave?
Er det sidste tilfældet vil jeg foreslå en ændring af det program, data eksporteres fra.

det er kun denne ene gang, heldigvis, fra gammelt til nyt system

Nu har jeg adskilt data i to kolonner i excel - kan man så ikke få programmet til at søge efter elementerne og indsætte dem, den finder i et andet work sheet og evt få den til at gå til næste bog, når den når til de blanke linjer eller firkanten?

hent din fil her og test selv.
http://tommy.bak.homepage.dk/bookstore.xls

Bravo! :o)

Øhm, hvodden kan jeg give dig points?

Sådan, så smider jeg et svar.... :-)

Den tilhørende kode, hvis nogen skulle være interessrede:


' Forudsætninger:
' Data står i kolonne A, Overskrifter står i G1:P1 incl :
' kolonne B-C-F er blanke
Sub Main()
    With Application
        .ScreenUpdating = False
        .StatusBar = "Datavask af originale data"
        CleanUpOriginalData
        .StatusBar = "Splitning i feltnavn og indhold"
        Data_Split
        .StatusBar = "Find Record-Addresser"
        FindRecordAddress
        .StatusBar = "Indsæt opslagsformler"
        Insert_Lookups
        .ScreenUpdating = True
        .StatusBar = False
    End With
End Sub

' Fjerner alle tomme celler og gør de celler hvor "" findes tomme,
' således at der kun er een tom celle mellem hver record
Private Sub CleanUpOriginalData()
Dim vTextOut As Variant, x As Long, vTextIn(), y As Long
    vTextOut = Range("A1:A" & Range("A65536").End(xlUp).Row)
    ReDim vTextIn(1 To UBound(vTextOut, 1), 1 To UBound(vTextOut, 2))
    For x = 1 To UBound(vTextOut, 1)
        If vTextOut(x, 1) <> "" Then
            y = y + 1
            vTextIn(y, 1) = vTextOut(x, 1)
            If vTextIn(y, 1) = "" Then vTextIn(y, 1) = ""
        End If
    Next
    Range("A:A").ClearContents
    Range("A1:A" & UBound(vTextIn, 1)) = vTextIn
End Sub

' Finder adresserne på hvert område, der indeholder en hel record
'(alt mellem de tomme linier)
Private Sub FindRecordAddress()
Dim rEntireRange As Range
Dim rg1 As Range, rg2 As Range
Dim x As Long, y As Long
    x = 2
    y = 1
    Set rEntireRange = Range("A1:A" & Range("A65536").End(xlUp).Row)
    While x < rEntireRange.Cells.Count
        Set rg1 = Range(Cells(x, 1), Cells(x, 1).End(xlDown))
        y = y + 1
        Set rg2 = Cells(y, 6)
        rg2.Value = rg1.Offset(, 1).Resize(, 2).Address
        x = rg1.End(xlDown).Row + 2
    Wend
End Sub

'Opdeler hver celle i to. Feltnavn og indhold
Private Sub Data_Split()
Dim lastrow As Long
    lastrow = [A65536].End(xlUp).Row
    [B2].FormulaR1C1 = "=LEFT(RC[-1],FIND(" & """:""" & ",RC[-1]))"
    [C2].FormulaR1C1 = "=RIGHT(RC[-2],LEN(RC[-2])-FIND("":"",RC[-2])-2)"
    [B2:C2].AutoFill Destination:=Range("B2:C" & lastrow)
End Sub

'Indsætter LOPSLAG for hver recordadresse og for hver overskrift i G1:P1
'kopierer resultatværdierne over på nyt ark.
Private Sub Insert_Lookups()
Dim lastrow As Long
Dim shValues As Object
    lastrow = [F65536].End(xlUp).Row
    [G2].FormulaR1C1 = "=IF(ISNA(VLOOKUP(R1C,INDIRECT(RC6),2,FALSE)),"""",VLOOKUP(R1C,INDIRECT(RC6),2,FALSE))"
    [G2].AutoFill Destination:=[G2:P2], Type:=xlFillDefault
    [G2:P2].AutoFill Destination:=Range("G2:P" & lastrow)
   
    Range("G1:P" & lastrow).Copy
    On Error Resume Next
    Set shValues = ActiveWorkbook.Sheets("result")
    If Err <> 0 Then
        Sheets.Add
        ActiveSheet.Name = "result"
    End If
    On Error GoTo 0
    Sheets("result").[A1].PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
End Sub

Hei. Hva slags script er dette? Skal gjøre det samme, men greier ikke se hva jeg skal gjøre for å få gjennomført det.