Anzeige
Archiv - Navigation
1352to1356
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Array kürzen

Array kürzen
14.03.2014 11:57:23
Frank
Hallo und Mahlzeit,
ich definiere in einer UDF bestimmte x und y Werte. Dazu markiere ich bspw. den Bereich für x von A1:A500 und für y von B1:B500. Nun ist es so, das in diesem Bereich die Zellen bspw. nur bis Zeile 300 mit Werte gefüllt sind. Die übrigen Zellen bis 500 sind leer. Wie kann ich in VBA mein Array um die leeren Zeilen kürzen, so dass es dann nur noch 300 Zeilen lang ist?
Ich hoffe das war verständlich.
Vielen Dank und viele Grüße
Frank

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Array kürzen
14.03.2014 12:19:36
UweD
Hallo Frank
so?
Range("A1:A500").SpecialCells(xlCellTypeConstants, 23
Nur Zellen mit konstanten Werte (Text, Zahlen, etc.) werden innerhalb des Bereichs betrachtet.
Wenn du die UDF hier abbildest sehen wir nach, wie das eingebaut werden kann
Gruß UweD

AW: Array kürzen
14.03.2014 13:30:42
Frank
Hallo UweD,
ich habe ein Beispiel angehangen. Mir geht es um die leeren Zellen des Arrays in VBA... Sowohl davor und danach...Ich hoffe mit der Datei wird meine Anfrage deutlich.
https://www.herber.de/bbs/user/89671.xls
Vielen Dank und viele Grüße
Frank

Anzeige
AW: Array kürzen
14.03.2014 14:21:25
fcs
Hallo Frank,
hier dein Makro angepasst
Gruß
Franz
Function test(x As Range, y As Range) As Double
Dim Matrix()
Dim i As Long, Zeile As Long
Dim xAnz As Long
Dim yAnz As Long
xAnz = Application.WorksheetFunction.CountA(x)
yAnz = Application.WorksheetFunction.CountA(y)
ReDim Matrix(1 To xAnz, 1 To 2)
For Zeile = 1 To x.Rows.Count
If Not IsEmpty(x.Cells(Zeile, 1)) Then
i = i + 1
Matrix(i, 1) = x.Cells(Zeile, 1).Value
Matrix(i, 2) = y.Cells(Zeile, 1).Value
End If
Next
i = 1
End Function

AW: Array kürzen
14.03.2014 15:36:02
Frank
Hallo Franz,
SUPER TOLL und vielen Dank funktioniert einwandfrei :-). Ich habe eben probiert. Das funktioniert auch wenn dazwischen mal einer fehlt. Also den Befehl IsEmpty kannte ich, aber auf den Syntax x.Cells(Zeile, 1).Value wäre ich wohl nicht gekommen. Ich habe mir mal die Eigenschaften von x im Debugmodus angesehen, weil ich den Wert gesucht habe. Und bin unter Value2 fündig geworden. Deshalb habe ich bei meinen Code nachdem ich die x-Werte bekommen habe erst einmal in einen neuen Vektor übertragen um nur noch die eigentlichen Werte drin zu haben. Da mir wie gesagt der Befehl x.Cells(Zeile, 1).Value nicht bekannt war :o(. Ich habe gerade gestoppt im Debugmode und bin auf x gegangen. Dort habe ich den Reiter Cells erweitert. Auch dort ist nur der Eintrag Value2 zu finden.... Wie also soll ein Laie wie ich darauf kommen x.cells().Value einzutippen :o)?
Vielen Dank und schon einmal ein erholsames und sonniges Wochenende.
Ach und was auch viel zu selten gesagt wird - Das beste Forum was ich kenne!
Frank

Anzeige
AW: Array kürzen
14.03.2014 13:16:43
fcs
Hallo Frank,
ein Weg besteht darin die letzte Zelle mit Werte im Bereich zu suchen und dann mit dem kleineren Bereichen weiter zu arbeiten.
Nachfolgend ein Beispiel.
Gruß
Franz
Sub prctest()
Dim A
A = fncArrayXY(rngX:=ActiveSheet.Range("A2:A500"), rngY:=ActiveSheet.Range("B2:B500"))
End Sub
Function fncArrayXY(rngX As Range, rngY As Range) As Variant
Dim arrX, arrY
Dim rngXneu As Range, rngYneu As Range
Dim rngZelle As Range, Zeile As Long
fncArrayXY = "Fehler"
'letzte Zelle mit Inhalt im X-Zellbereich
Set rngZelle = rngX.Cells.Find(what:="*", after:=rngX.Cells(1, 1), LookIn:=xlValues, _
lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious)
If rngZelle Is Nothing Then
MsgBox "keine Daten im x-WerteBereich!"
GoTo Beenden
Else
Set rngXneu = rngX.Parent.Range(rngX.Range("A1"), rngZelle)
End If
'letzte Zelle mit Inhalt im Y-Zellbereich
Set rngZelle = rngY.Cells.Find(what:="*", after:=rngY.Cells(1, 1), LookIn:=xlValues, _
lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious)
If rngZelle Is Nothing Then
MsgBox "keine Daten im y-WerteBereich!"
GoTo Beenden
Else
Set rngYneu = rngY.Parent.Range(rngY.Range("A1"), rngZelle)
End If
'ggf. Konsistenz der Daten prüfen
If rngXneu.Rows.Count  rngYneu.Rows.Count Then
MsgBox "Datenbereiche für X- und Y-Werte haben unterschiedliche Anzahl werte!!"
GoTo Beenden
End If
arrX = rngXneu
arrY = rngYneu
'Arrays verarbeiten
fncArrayXY = 0
If rngXneu.Rows.Count = 1 Then
fncArrayXY = arrX * arrY + arrX - arrY
Else
For Zeile = LBound(arrX, 1) To UBound(arrX, 1)
fncArrayXY = fncArrayXY + (arrX(Zeile, 1) * arrY(Zeile, 1)) + arrX(Zeile, 1) _
- arrY(Zeile, 1)
Next
'Arrays wieder leeren
Erase arrX, arrY
End If
Beenden:
Set rngXneu = Nothing: Set rngYneu = Nothing: Set rngZelle = Nothing
End Function

Anzeige
AW: Array kürzen
14.03.2014 13:43:55
Frank
Hallo Franz,
vielen Dank Franz. Puhh das ist ganz schön viel auf einmal Da muss ich erst einmal durchsteigen bzw. werde ich es versuchen. Dennoch vielen Dank. Mal schauen vielleicht ergeben sich noch Ideen.
Ich wünsche ein sonniges Wochenende.
Frank

Da geht's wohl weiter...
14.03.2014 14:52:23
Luc:-?
…→Klick!
SchöWE allerseits, Luc :-?

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige