Just nu i M3-nätverket
Gå till innehåll

en array i arrayen


johnJ

Rekommendera Poster

Hej!

 

Har lite problem med arrayer i Excel 97.

Jag utvecklar en excel appl. i Excel 2000.

I 2000 fungerar allt men inte i 97 som det även måste göra.

 

Får felet:

Compile error: Can't assign to array

när jag kör: files(UBound(files)).SheetYears = d

 

där d och files är en array.

 

Deklarationerna är följande:

 

Type SheetYear

YearNo As String

SumRow As Integer

End Type

 

Type PlanFile

Fullname As String

Filename As String

Owner As String

SheetYears() As SheetYear

End Type

 

Global files() As PlanFile

...

Dim d() As SheetYear

ReDim d(cc) As SheetYear

 

Det är möjligt att problem går att lösa på ett annat sätt så därför beksriver jag

syftet med detta.

Programmet letar efter excel filer, uppgifter ska sparas för de filer uppfyller vissa krav.

För varje excelfil sparas Fullname (sökväg + filnamn), FileName, Owner (hämtas från en cell)

samt lite information om varje blad som finns i fil.

 

Problemet är att en excelfil kan ha flera blad så det blir en array i arrayen vilket fungerar i Excel 2000 men inte 97.

 

Jag bifogar även all kod i nuvarande skick, ScanFiles() är den funktionen som anropas för att starta allt.

Om ngn vill ha möjlighet att köra applikationen så maila mig så kan jag skicka över allt.

 

Tack på förhand.

Mvh. John J

 

Type SheetYear

YearNo As String

SumRow As Integer

End Type

 

Type PlanFile

Fullname As String

Filename As String

Owner As String

SheetYears() As SheetYear

End Type

 

Global Const startaty = 4

Global files() As PlanFile

 

Function ScanFiles()

 

'Skapar lista med referenser

ReDim files(0) As PlanFile

SearchPlanXLSFile

If UBound(files) > 0 Then 'Filer har hittats

 

'Sorterar lista med referenser efter försäljarens namn

Dim intTempStore As PlanFile

Dim i, j

 

For i = 0 To UBound(files) - 2

For j = i To UBound(files) - 1

If files(i).Owner > files(j).Owner Then

intTempStore = files(i)

files(i) = files(j)

files(j) = intTempStore

 

End If

Next j

Next i

 

ScanFiles = True

Else

ScanFiles = False

End If

 

End Function

 

Sub SearchPlanXLSFile()

Dim MyName As String

MyPath = Application.ActiveWorkbook.Fullname

Dim pos As Integer

Do While InStr(pos + 1, MyPath, "\")

pos = InStr(pos + 1, MyPath, "\")

Loop

thisfile = LCase(Right(MyPath, Len(MyPath) - pos))

MyPath = Left(MyPath, pos)

 

MyName = Dir(MyPath, vbDirectory)

Do While MyName <> ""

If MyName <> "." And MyName <> ".." Then

If Not (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory And InStr(LCase(MyName), ".xls") = Len(MyName) - 3 And Not LCase(MyName) = thisfile Then

OpenPlanXLSFile MyPath & MyName, MyName

End If

End If

MyName = Dir

Loop

End Sub

 

Sub OpenPlanXLSFile(Fullname As String, Filename As String)

Dim oExcel As Excel.Application

Set oExcel = New Excel.Application

oExcel.Workbooks.Open Filename:=Fullname

oExcel.Visible = False

 

On Error Resume Next

inf = oExcel.Worksheets("Info").Cells(1, 1)

If Err.Number = 0 Then

On Error GoTo 0:

If inf = "PLAN" Then

cc = oExcel.Worksheets.Count - 2 - 1

If cc >= 0 Then

Dim d() As SheetYear

ReDim d(cc) As SheetYear

For x = 3 To oExcel.Worksheets.Count

d(x - 3).YearNo = oExcel.Worksheets(x).Name

d(x - 3).SumRow = GetEndAtYBySheet(oExcel.Worksheets(x)) + 1

Next x

 

files(UBound(files)).Filename = Filename

files(UBound(files)).Fullname = Fullname

files(UBound(files)).Owner = oExcel.Worksheets("Info").Cells(2, 1)

files(UBound(files)).SheetYears = d

 

ReDim Preserve files(UBound(files) + 1) As PlanFile

End If

End If

Else

On Error GoTo 0:

End If

 

oExcel.ActiveWorkbook.Close False

oExcel.Quit

Set oExcel = Nothing

End Sub

 

Function GetEndAtYBySheet(sheetName As Worksheet)

On Error GoTo fel_GetEndAtYBySheet:

endaty = 0

For x = startaty To sheetName.UsedRange.Rows.Count

If UCase(Trim(sheetName.Cells(x, 1))) = "TOTALSUMMA" Then

endaty = x - 1

Exit For

End If

Next x

 

If endaty = 0 Then

endaty = sheetName.UsedRange.Rows.Count - 1

End If

 

GetEndAtYBySheet = endaty

Exit Function

fel_GetEndAtYBySheet:

GetEndAtYBySheet = 0

Exit Function

End Function

Länk till kommentar
Dela på andra webbplatser

Johnj,

 

Skicka filen till mig så har jag underlaget i körklart skick.

 

En hastig genomläsning ger inga aha-uplevelser.

 

Du anropar XL utifrån och då uppstår alltid frågan om

- Referens till XL:s library

och

- om referensen är satt till 9.0 medan 97:an kräver 8.0

 

Detta är s k "early binding", vilket koden ger uttryck för genom

New Excel.Application.

 

Frågan är om du kan lösa problemet genom att ersätta early binding med late binding, dvs

 

Dim XLApp as Object

Set XLapp = CreateObject("Excel.Application")

 

 

Mvh

Dennis

Besök Sveriges ledande oberoende webbplats om MS Excel: http://www.xldennis.com

 

Länk till kommentar
Dela på andra webbplatser

Johnj,

 

Du anropar inte XL utifrån utan skapar en ny instans av XL.

 

Frågorna kvarstår dock.

 

Mvh

Dennis

Besök Sveriges ledande oberoende webbplats om MS Excel: http://www.xldennis.com

 

Länk till kommentar
Dela på andra webbplatser

Hej!

 

Du får allt underlag imorgon då jag inte har tillgång till det nu.

 

Metoden jag använder för att läsa andra excel filen har direkt inget med mitt problem att göra men andra metoder är självklart uppskattat. Som det är nu tar körning en bra tid på sig (kan självklart optimeras genom att inte använda felhantering för att ta reda på om bladet Info finns).

 

Observera att allt fungerar i 2000, det är i 97 det inte fungerar. Felet uppstår då jag vill lagra en array i en annan array.

 

Mvh. John

 

Länk till kommentar
Dela på andra webbplatser

John,

 

Jag förstår problemet.

 

I 2000 fungerar det att "dumpa" en array i en annan array medan i 97 krävs att du loopar igenom den egendefinerade arrayen SheetYears

och tilldela den värden från arrayen d.

 

I 2002 får du automationsfel till följd av att du öppnar en ny instans för varje arbetsbok som öppnas.

 

I vissa avseenden gillar jag din lösning men i andra lämnar den en hel del önskemål.

 

Ett krav är att du måste deklarera alla variabler. Enklast är att ange Option Explicit högst upp i varje modul - detta kan också ställas in så att det sker automatiskt.

 

En annan sak är att lösningen innhehåller många transporter av data och i kombination med ett flertal arrayer blir prestandan lidande.

 

Enklast och för bästa prestanda är att

1. Använda sig av filesearch

2. Skriva funnen data till ett dolt arbetsblad och därefter hämta in den i kod för vidarebearbetning.

 

Att skriva om din lösning och tillhandahålla den går utanför mitt engagemang här på E-forum vilket jag ber att det respekteras.

 

Att ge mig in i din kod och implementera lösningen är också något som går utanför mitt engagemang.

 

Det du får är ett underlag med vilket du kan lösa problemet att loopa igenom SheetYears. Du får därefter implementera lösningen själv.

 

Följande fungerar i XL 97, 2000 och i XP.

 

Option Explicit

Type SheetYear
   YearTotal As String
   SumTotal As Integer
End Type

Type PlanFile
   Fullname As String
   Filename As String
   Owner As String
   SheetYears() As SheetYear
End Type


Sub Test()
Dim File As PlanFile
Dim i As Long

File.Fullname = "AAAA"
File.Filename = "C:\MyDocuments\stat.xls"
File.Owner = "John"

ReDim File.SheetYears(1 To 5)

For i = 1 To 5
 File.SheetYears(i).YearTotal = 1998+i 
 File.SheetYears(i).SumTotal =  2 * 8 + i
Next

Debug.Print File.Fullname
Debug.Print File.Filename
Debug.Print File.Owner

For i = LBound(File.SheetYears) To _
 UBound(File.SheetYears)
 Debug.Print i, File.SheetYears(i).YearTotal
 Debug.Print i, File.SheetYears(i).SumTotal
Next

ReDim Preserve File. _
 SheetYears(LBound(File.SheetYears) _
 To UBound(File.SheetYears) + 1)

With File.SheetYears(UBound(File.SheetYears))
 .SumTotal = 100
 .YearTotal = 200
End With

i = UBound(File.SheetYears)
With File.SheetYears(i)
Debug.Print .YearTotal
Debug.Print .SumTotal
End With

End Sub

 

 

Mvh

Dennis

Besök Sveriges ledande oberoende webbplats om MS Excel: http://www.xldennis.com

 

Länk till kommentar
Dela på andra webbplatser

Arkiverat

Det här ämnet är nu arkiverat och är stängt för ytterligare svar.

×
×
  • Skapa nytt...