|
| Kommentar Fra : nipmads |
Dato : 31-03-04 22:41 |
|
forstår jeg godt!
Jeg har et excel ark med nogen effekter fra et museum, som der står i et regneark, kan hentes her: www.mapro.dk/museum.xls
Jeg skal lave et VBA script som for hver effekt, omskriver informationerne således at hver effekt kun optager en linje, på følgende form og skriver informationeren til et andet ark:
Reg. nr, underkategori, placering, sprog, ejer, overskrift/navn, beskrivelse, skænket/deponeret af navn, add, postnr, by, tlf
og der er jeg total på bar bund!
det er noget med at samle info, og smide det over i et andet ark...
| |
| Accepteret svar Fra : berpox | Modtaget 200 point Dato : 01-04-04 01:55 |
|
Okay - her er en mulighed:
Opret et ekstra fanablad i dit Excelark og navngiv det "Converted"
Afspil følgende makro:
Kode Option Explicit
Dim Reg As Integer
Dim n, i, t As Integer
Dim counter As Integer
Dim Kat As String
Dim Pla As String
Dim Spr As String
Dim Ejer As String
Dim Emne As String
Sub Convert_Database()
On Error Resume Next
Worksheets("old_database").Activate
n = 6 'starting row number old database
i = 2 'starting row number converted database
counter = 500 'number of excel-lines
For n = n To n + counter
Reg = Worksheets("old_database").Range("B" & n) 'Get Reg. #
'Worksheets("old_database").Activate
'Worksheets("old_database").Range("B" & n).Select
If Reg <> Worksheets("old_database").Range("B" & n + 1) Then
i = i + 1
End If
Write_First_Informations 'Reg, Kat, Pla, Spr, Ejer
If Not Reg <> Worksheets("old_database").Range("B" & n + 1) Then
Emne = Worksheets("old_database").Range("G" & n)
If Emne = CStr(Reg) Then
Emne = ""
End If
Worksheets("Converted").Activate
Worksheets("Converted").Range("F" & i) = (Worksheets("Converted").Range("F" & i) & Emne & " ")
End If
Next
Delete_Empty_Lines
End Sub
Function Write_First_Informations()
Reg = Worksheets("old_database").Range("B" & n)
Kat = Worksheets("old_database").Range("C" & n)
Pla = Worksheets("old_database").Range("D" & n)
Spr = Worksheets("old_database").Range("E" & n)
Ejer = Worksheets("old_database").Range("F" & n)
Emne = Worksheets("old_database").Range("G" & n)
Worksheets("Converted").Range("A" & i) = Reg
Worksheets("Converted").Range("B" & i) = Kat
Worksheets("Converted").Range("C" & i) = Pla
Worksheets("Converted").Range("D" & i) = Spr
Worksheets("Converted").Range("E" & i) = Ejer
End Function
Function Delete_Empty_Lines()
Worksheets("Converted").Activate
t = 2
For t = 2 To n
Range("A" & t).Select
If (Selection = 0) Or Selection = "" Then
Range("A" & t, "Z" & t).Delete
End If
Next
For t = 2 To n
Range("F" & t).Select
If (Selection = 0) Or Selection = "" Then
Range("A" & t, "Z" & t).Delete
End If
Next
Range("A1").Select
End Function |
Er det sådan du vil have det?
1) Jeg lægger Reg., Kat., Pla., Spr. samt Ejer i hver sin celle vandret i det nye ark (Converted)
2) Jeg samler alle tekster i kategorien "Emne" i en celle i det nye ark (Converted) - vandret efter pkt. 1
3) Til sidst sletter jeg alle tomme linier i det nye ark
mvh Berpox
| |
| Kommentar Fra : berpox |
Dato : 01-04-04 01:58 |
|
Argh.... Kandu KAN bare IKKE det der med linieskift...
Der SKAL være linieskift EFTER "End If"
mvh Berpox
| |
| Godkendelse af svar Fra : nipmads |
Dato : 01-04-04 14:43 |
|
Tusind mange tak for den super duper excellente besvarelse, du skulle have en medalje!
Du har virkelig hjulpet mig, mange gange tak!
mvh
Nipmads
| |
| Kommentar Fra : berpox |
Dato : 01-04-04 15:29 |
|
Velbekomme da - og jeg regner med at du har luret, at det er counter = 500 der korrigeres (forøges væsentligt) for at få alle linierne i arket gennemgået ikk' ?
Og hvis du så samtidigt blev bare lidt klogere på VBA i Excel - så er det jo ganske godt gået
mvh Berpox
| |
| Kommentar Fra : nipmads |
Dato : 01-04-04 23:39 |
|
jo, jeg fandt ud af det med linjeskift, men glemte den der counter del, men det er ikke for sent, hovedsagen er at det virker, og det gjorde det med det samme..
endnu en gang tak, og go påske
| |
| Kommentar Fra : nipmads |
Dato : 05-05-04 14:45 |
|
Hej Berpox...
Har du mulighed for at skrive en mail til mig? Jeg skal gerne have noget merer hjælp, og vil godt give en belønning for det... hvis det er?
mvh
Nipmads
| |
| Kommentar Fra : nipmads |
Dato : 05-05-04 15:25 |
| | |
| Du har følgende muligheder | |
|
Eftersom du ikke er logget ind i systemet, kan du ikke skrive et indlæg til dette spørgsmål.
Hvis du ikke allerede er registreret, kan du gratis blive medlem, ved at trykke på "Bliv medlem" ude i menuen.
| |
|
|