PDA

Vollständige Version anzeigen : Element im Int-Array löschen und re-dimensionieren


kerim80
28.02.2008, 13:26
Hallo,

ich will mich kurz/knapp halten. Habe Excel 2007.
Folgendes Szenario und Problem habe ich:

1. habe ein "Gewichtetes Array" vom Typ=Integer, z.B. (0,0,0,0,0,0,1,1,1,2,2,2,2,2,2,2,2,2,2,2,3,3,etc.) / Einträge von 0 bis 24
2. wähle mir mit folgendem Code aus diesem Array per Zufall einen Eintrag aus:

x = PosZahl(UBound(GewichteterArray))
Private Function PosZahl(ByRef ObereGrenze As Integer) As Integer
Randomize -Timer ' Sicherstellen, daß bei jedem Start wirklich eine neue Zufallszahl generiert wird
PosZahl = Int(Rnd * ObereGrenze) ' gibt Zahlen im Bereich von [0 - Oberegrenze] End Function

3. lösche diese Eintrag (Zufallszahl) aus dem Array, mit folgendem Code:
den Code habe ich von der Seite: http://www.vbarchiv.net/archiv/tipp_955.html

ArrayDelete GewichteterArray, x

Private Declare Sub CopyMemoryPtr Lib "kernel32" _
Alias "RtlMoveMemory" ( _
ByVal Destination As Long, _
ByVal Source As Long, _
ByVal Length As Long)

Public Sub ArrayDelete(ByRef sArray() As Integer, _
ByVal nDelPos As Long, _
Optional ByVal nSize As Variant, _
Optional ByVal bRedimSize As Variant)

Dim nPtr As Long

' Größe des Arrays bestimmen, falls nicht angegeben
If IsMissing(nSize) Then nSize = UBound(sArray)

If nDelPos < nSize Then
' Element aus Array löschen und alle
' nachfolgende Elemente nach vorne schieben
nPtr = StrPtr(sArray(nDelPos))
CopyMemoryPtr VarPtr(sArray(nDelPos)), VarPtr(sArray(nDelPos + 1)), _
VarPtr(sArray(nSize)) - VarPtr(sArray(nDelPos))
CopyMemoryPtr VarPtr(sArray(nSize)), VarPtr(nPtr), Len(nPtr)
End If

' Array ggf. autom. um 1 Element verkleinern
If IsMissing(bRedimSize) Then bRedimSize = True
If bRedimSize Then
nSize = nSize - 1
If nSize < 0 Then nSize = 0
ReDim Preserve sArray(nSize)
Else
sArray(nSize) = 0
End If
End Sub


4. gibt er mir im MS-VB-Editor die Fehlermeldung "Nicht genügend Speicher" oder schließt automatisch das EXCEL-Programm

-> Habt ihr einen Lösungsvorschlag oder einen anderen, wie ich ein ausgewähltes Element von einem Integer-Array lösche und danach redimensioniere???

IngGi
28.02.2008, 14:13
Hallo Kerim,

mit VBA-Bordmitteln:
<FONT Color=Black FACE="Courier New,FixedSys" Size=2>
<Blockquote>
<FONT COLOR=#0000FF>Dim</FONT>&nbsp;x&nbsp;<FONT COLOR=#0000FF>As&nbsp;Integer</FONT>,&nbsp;i&nbsp;<FONT COLOR=#0000FF>As&nbsp;Integer</FONT>
<FONT COLOR=#0000FF>Dim</FONT>&nbsp;GewichteterArray()&nbsp;<FONT COLOR=#0000FF>As&nbsp;Integer</FONT>
<FONT COLOR=#0000FF>ReDim</FONT>&nbsp;GewichteterArray(1&nbsp;<FONT COLOR=#0000FF>To</FONT>&nbsp;5)

x&nbsp;=&nbsp;PosZahl(<FONT COLOR=#0000FF>UBound</FONT>(GewichteterArray))
<FONT COLOR=#0000FF>For</FONT>&nbsp;i&nbsp;=&nbsp;x&nbsp;<FONT COLOR=#0000FF>To&nbsp;UBound</FONT>(GewichteterArray)&nbsp;-&nbsp;1
&nbsp;&nbsp;GewichteterArray(i)&nbsp;=&nbsp;GewichteterArray(i&nbsp;+&nbsp;1)
<FONT COLOR=#0000FF>Next</FONT>&nbsp;<FONT COLOR=#008000>'i</FONT>
<FONT COLOR=#0000FF>ReDim&nbsp;Preserve</FONT>&nbsp;GewichteterArray(1&nbsp;<FONT COLOR=#0000FF>To&nbsp;UBound</FONT>(GewichteterArray)&nbsp;-&nbsp;1)

<FONT Size=2>
<p>Code eingefügt mit <b><a href="http://rtsoftwaredevelopment.de" target="_blank">Syntaxhighlighter 4.14</a></b></FONT></p>
</Blockquote><FONT FACE="Arial,FixedSys"Size=3>Gruß Ingolf

kerim80
29.02.2008, 02:26
danke dir
hat mir sehr weitergeholfen :)

bst
29.02.2008, 07:54
Morgen auch,

Du brauchst M.E. hier weder die Zahl aus dem Array zu löschen, noch das Array zu redimensionieren. Kopiere einfach das letzte Arrayelement auf das gezogene Element um und erniedrige dann die obere Grenze um 1. Siehe Beispiel.

cu, Bernd
--
Option Explicit

Sub x()
Dim ar As Variant, i As Integer, j As Integer, intZufall As Integer

ar = Array("A", "B", "C", "D", "E", "F")

Randomize Timer ' 'Mischen'
i = UBound(ar) ' Der max. Arrayindex
For j = 1 To UBound(ar) + 1 ' Alle Elemente ziehen
intZufall = Int(Rnd() * i) ' Eine Zufallszahl zwischen 0 und i ziehen
Debug.Print ar(intZufall); " ";
ar(intZufall) = ar(i) ' Die 'letzte' Zahl umkopieren
i = i - 1 ' den Max-Index um eines erniedrigen
Next
Debug.Print
End Sub