Office: Index Funktion

Friedrich89 · 3. August 2013

Guten Abend Ihr lieben,

ich habe ein kleines Problem mit meinem Sverweis bzw. mit meiner Index Funktion ...

Wenn ich den Code so durchlaufen lasse, bekomme ich immer die Meldung "Laufzeitfehler '13'" Typen unverträglich *frown.gif*

Code:

Private Sub test1_click()
Dim criteria_A As Variant
Dim criteria_B As Variant
Dim target As Variant
Dim rngcriteria_A As Range
Dim rngcriteria_B As Range
Dim rngtarget As Range

set rngcriteria_A = Sheets("Hilfsliste").Range("A:A")
set rngcriteria_B = Sheets("Hilfsliste").Range("E:E")
set rngtarget = Sheets("Hilfsliste").Range("I:I")

With Application.WorksheetFunction

target = .Index(rngtarget, .Match(criteria_A & criteria_B, rngcriteria_A & rngcriteria_B , 0))

End With

MsgBox target

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ich gehen mal davon aus, dass das Problem darin liegt, dass ich die Index Funktion nicht als Array definiert habe, allerdings weiß ich auch nicht wie ich das machen könnte. *frown.gif*

Ich hoffe mal Ihr könnt mir helfen *Smilie

Vielen lieben Dank Euch *Smilie

Beste Grüße

Friedrich

:)

aloys78 · 5. August 2013

Hallo Friedrich,

Code:

.Match(criteria_A & criteria_B, rngcriteria_A & rngcriteria_B , 0)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

mE geht das so nicht:
Abgesehen davon, dass die Suchbegriffe criteria_A und criteria_B
nicht gefüllt werden, besteht die Matrix aus 2 statt aus 1 Spalte.

Ich würde es so lösen:
mit Find und FindNext criteria_A in Spalte A aufsuchen, dann criteria_B mit Wert in Spalte I vergleichen.

Gruß
Aloys

Friedrich89 · 5. August 2013

Sorry, criteria a und b werden aus ner Userform eingespeist *Smilie

Wie würde der Code denn dafür aussehen? "Find" kenn ich selber leider gar nicht *frown.gif* Kannst Du mir da bitte helfen?

Mit meinem Code klappt es zumindest in Excel selber, wenn ich den als Array abschließe.

aloys78 · 5. August 2013

Hallo Friedrich,

Sorry, criteria a und b werden aus ner Userform eingespeist
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ich sehe aber nicht, wie das mit deinem Code zusammen passen soll.

Nachstehend ein Codevorschlag; criteria a und b wurden für Testzwecke eingefügt.
Code:

Option Explicit

Private Sub test1_click()
Dim criteria_A As Variant
Dim criteria_B As Variant
Dim target As Variant
Dim rngcriteria_A As Range
Dim rngcriteria_B As Range
Dim rngtarget As Range

Dim c As Range 'Ergebnis von Find
Dim firstAddress As String

Set rngcriteria_A = Sheets("Hilfsliste").Range("A:A")
Set rngcriteria_B = Sheets("Hilfsliste").Range("E:E")
Set rngtarget = Sheets("Hilfsliste").Range("I:I")

'für Test
criteria_A = "ccc"
criteria_B = 3

With rngcriteria_A
Set c = .Find(criteria_A, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
If criteria_B = Sheets("Hilfsliste").Range("E" & c.Row) Then
target = Sheets("Hilfsliste").Range("I" & c.Row)
Exit Do
Else
Set c = .FindNext(c)
End If
Loop While Not c Is Nothing And c.Address firstAddress
Else
MsgBox criteria_A & " nicht gefunden !"
Exit Sub
End If
End With
MsgBox target
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Gruß
Aloys

Friedrich89 · 5. August 2013

Vielen Dank Dir schonmal, das tool funktioniert soweit auch schon super *Smilie

Gibt es nur eine Möglichkeit das einfacher zu gestalten? ich muss den einen Befehl direkt 20 mal durchführen und dabei wird der code extrem unübersichtlich *frown.gif*

Hast Du da vielleicht eine idee für mich?

Friedrich89 · 6. August 2013

Ich hab's mal so probiert, allerdings komme ich so auch nicht auf's richtige Ergebnis

Code:

Private Sub test3_Click()
Dim arr As Variant
Dim i As Long
Dim comp As String

With Worksheets("Hilfsliste")
arr = .Range("A2:R" & .Cells(.Rows.Count, 1).End(xlUp).Row)
End With

For i = 1 To UBound(arr)
If arr(i, 1) = 2000 Then 'Suchvariable 1
If arr(i, 5) = 9002 Then ' Suchvariable 2
comp = Sheets("Hilfsliste").Range(i & "I")
End If
End If
Next
If comp "" Then
MsgBox comp
Else
MsgBox "Nix gefunden!"
End If
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Fällt Euch da ein Fehler auf?

Als Info dazu, die Daten sehen so aus:

A E I
0001 9001 dwe
0001 9002 157
1000 9001 123
1000 9002 456
2000 9001 abc
2000 9002 785

Danke schonmal *Smilie

aloys78 · 6. August 2013

Hallo Friedrich,

nachstehend mein entsprechend angepasster Code, dazu
- ein paar deiner Definitionen außerhalb deiner Prozedur definiert (wobei target kein idealer Variablen-Name ist (belegt durch Sheet-Ereignisprozeduren),
- meine Suchroutine ausgelagert, so dass deine Prozedur relativ übersichtlich bleibt.

Code:

Option Explicit
Dim criteria_A As Variant
Dim criteria_B As Variant
Dim target As Variant

Private Sub test1_click()
Dim rngcriteria_A As Range
Dim rngcriteria_B As Range
Dim rngtarget As Range

Set rngcriteria_A = Sheets("Hilfsliste").Range("A:A")
Set rngcriteria_B = Sheets("Hilfsliste").Range("E:E")
Set rngtarget = Sheets("Hilfsliste").Range("I:I")

'für Test
criteria_A = "ccc": criteria_B = 3
Call Suchen_AB

criteria_A = "eee": criteria_B = 5
Call Suchen_AB

End Sub

Sub Suchen_AB()
Dim c As Range 'Ergebnis von Find
Dim firstAddress As String
Dim sw As Boolean
target = ""
sw = False
With Sheets("Hilfsliste").Range("A:A")
Set c = .Find(criteria_A, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
If criteria_B = Sheets("Hilfsliste").Range("E" & c.Row) Then
target = Sheets("Hilfsliste").Range("I" & c.Row)
sw = True
Exit Do
Else
Set c = .FindNext(c)
End If
Loop While Not c Is Nothing And c.Address firstAddress
Else
MsgBox criteria_A & " nicht gefunden !"
Exit Sub
End If
End With
If sw = True Then
MsgBox target
Else
MsgBox "kein criteria_B für " & criteria_A & " gefunden !"
End If
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Gruß
Aloys

Friedrich89 · 6. August 2013

Vielen Dank Dir Aloys, echt genial wie Du das Problem gelöst hast, es kann manchmal so einfach sein *Smilie

Kannst Du mir vielleicht noch sagen, wie ich es anstellen kann, dass ich dabei auch alle möglichen Werte rechts von Spalte I mit berücksichtige und mit einem Simikolon verkette.

Das ganze soll dann für Kriterium B = rf in das Label rf geschrieben werden und für das Kriterium B = fg in das Label fg.

Ich versuch's schon den ganzen Tag umzusetzten nur so recht komme ich nicht darauf wie ich's sinnvoll umsetzen kann *frown.gif*

Könntest Du mir da bitte nochmal helfen? Ich hab wohl noch viel zu lernen ... *Smilie

aloys78 · 6. August 2013

Hallo Friedrich,

...wie ich es anstellen kann, dass ich dabei auch alle möglichen Werte rechts von Spalte I mit berücksichtige und mit einem Simikolon verkette.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Das heisst, in target ist der Wert aus Spalte I mit etwa vorhandenen Werten ab Spalte J und folgende zu verketten. Das macht der nachstehende Code.

Bei deiner nächsten Problemstellung muss ich passen:

Das ganze soll dann für Kriterium B = rf in das Label rf geschrieben werden und für das Kriterium B = fg in das Label fg.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Meinst du vielleicht criteria_A und criteria_B ?
Und was wäre ganz konkret damit zu tun ?

Gruß
Aloys

Code:

Sub Suchen_AB()
' V 3 vom 06.08.2013
Dim c As Range 'Ergebnis von Find
Dim s As Long 'Spalten#
Dim LoLetzte As Long
Dim firstAddress As String
Dim sw As Boolean
target = ""
sw = False
With Sheets("Hilfsliste").Range("A:A")
Set c = .Find(criteria_A, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
If criteria_B = .Range("E" & c.Row) Then
With Sheets("Hilfsliste")
target = .Range("I" & c.Row)
LoLetzte = .Cells(c.Row, Columns.Count).End(xlToLeft).Column
s = 10
Do While s
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Friedrich89 · 6. August 2013

vielleicht hab ich's auch zu komisch dargestellt, im Prinzip geht's darum, dass ich ein Kriterium A suche, das 2 Unterkategorien (Kriterium B in Spalte E) hat, welche in jedem Wert für die Kategorie A gleich bleiben. Diese müssen dann in eine Userform einlesen werden.

Im Bsp. ist z.B. die Kategorie B mit der 9001 und der 9002 die Unterkategorie für alle Kategorien A (0001/1000/2000).
Jetzt sollen die Werte aus der Spalte I nach vorheriger Suche nach dem Kriterium A für das Kriterium 9001 und 9002 in eine UserForm gelesen werden.

Z.B. hätte ich gerne gerne, wenn ich als Suche die 0001 eingebe, in meiner UserForm als Ergebnis dwe und 157. Dabei ist das Ziel in der UserForm immer gleich für alle Kriterien B.

A E I
0001 9001 dwe
0001 9002 157
1000 9001 123
1000 9002 456
2000 9001 abc
2000 9002 785

Vielen lieben Dank Dir schonmal ich hoffe mal es so deutlicher gemacht zu haben und bin mir sicher, dass Dir dazu wieder was total einfaches einfällt *Smilie

aloys78 · 6. August 2013

Hallo Friedrich,

ich meine, dass mein Lösungsvorschlag die Anforderungen voll abdeckt.
criteria_A=1000
criteria_B=9002
Call Suchen_AB 'liefert Ergebnis 456 in target

Wenn du das Ergebnis für 1000 / 9001 haben möchtest, rufst du erneut Suchen_AB auf. Allerdings ist jetzt das Ergebnis in target = 123 plus Inhalte der folgenden Spalten, wie von dir gewünscht.

Ich habe die Datei in der neuesten Fassung beigefügt: Friedrich_V3.xlsm

Wenn das wider Erwarten nicht deinen Vorstellungen entspricht, solltest du mal deine Datei hochladen.

Gruß
Aloys

Friedrich89 · 11. August 2013

Hallo Aloys,

Du hast absolut recht, ich habe was übersehen, daher hat's nicht funktioniert *Smilie

Gerade plagt mich bei meinem Projekt nurnoch das reinschreiben in die excel Datei.

Die Situation sieht so aus, dass ich eine TextBox und eine CheckBox habe, dabei müssen in die Textbox mehrere(nicht immer gleich viele) fixe Werte(Zahlen) eingegeben werden, welche durch ein Simikolon getrennt werden (mir fiel nichts besseres für die Eingabe von mehreren fixen Werten ein). Mit der Checkbox werden die Werte zusätzlich bestätigt.

Mein Problem dabei ist, dass jeder fixe Wert in eine eigene Zelle im excel sheet geschrieben werden soll, also erkannt werden soll, dass nach einem Simikolon ein neuer Wert folgt.
Zum Schluss soll rechts neben den letzten fixen Wert durch die CheckBox "Bestätigt" oder nichts hingeschrieben werden.

Da bin ich jetzt schon seit nen paar Tagen dran und komm einfach nicht drauf ... Kannst Du mir da bitte nochmal helfen? Wäre echt super nett *Smilie

aloys78 · 11. August 2013

Hallo Friedrich,

Gerade plagt mich bei meinem Projekt nurnoch das reinschreiben in die excel Datei.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Kannst du mal eine Beispieldatei hochladen.
Bisher kann ich nicht nachvollziehen
- warum du die Werte-Erfassung nicht direkt im Excel-Blatt vornimmst,
- wenn schon mit Textboxen, warum du nur eine mit einer etwas unkomfortablen Semikolon-Zusatzeingabe nutzt.

Gruß
Aloys

Friedrich89 · 11. August 2013

Guten Abend Aloys,

- warum du die Werte-Erfassung nicht direkt im Excel-Blatt vornimmst,
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

weil die Werterfassung zu meinem großen vba Projekt gehört und daher in der UserForm erfolgen muss.

- wenn schon mit Textboxen, warum du nur eine mit einer etwas unkomfortablen Semikolon-Zusatzeingabe nutzt.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wenn Dir was besseres dafür einfällt bin ich gerne für alle Ideen offen *Smilie
Mehr als eine Textbox kann ich allerdings aus Platzgründen nicht unterbringen.

Vielen Dank Dir *Smilie

Und noch die Beispieldatei:

Erich G. · 11. August 2013

Hi,
hier mal ein Codevorschlag für das Eintragen: Code:

Private Sub CommandButton2_Click()
Dim lngZ As Long, arrT, intA As Integer, arrE(), ii As Integer
Const TZ = "*" ' Trennzeichen für Texte in TextBox1

With Sheets("Tabelle1")
If TextBox1 > "" Then
lngZ = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(lngZ, 1) = Application.Max(.Cells(2, 1).Resize(lngZ - 1)) + 1
arrT = Split(TextBox1, TZ)
intA = UBound(arrT)
ReDim arrE(0 To intA)
For ii = 0 To intA
If IsNumeric(arrT(ii)) Then
arrE(ii) = CDbl(arrT(ii)) ' Text zu Zahl
Else
arrE(ii) = arrT(ii)
End If
Next ii
.Cells(lngZ, 2).Resize(, intA + 1) = arrE
If CheckBox1 Then .Cells(lngZ, intA + 3) = "bestätigt"
TextBox1 = "" ' evtl. leeren?
CheckBox1 = False ' evtl. zurückstellen?
End If
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Als Trennzeichen habe ich mal "*" verwendet - das ist auch im Zehnerblock gut erreichbar.

Noch ein Tipp:
Stell doch mal die Eigenschaft "TakeFocusOnClick" des CommandButton1 auf Tabelle1 auf False
(via Entwicklertools - Entwurfsmodus - rechte Maustaste auf den Button - Eigenschaften)

Office: Index Funktion

Index Funktion

Index Funktion

Index Funktion

Index Funktion

Index Funktion

Index Funktion - Similar Threads - Index Funktion

Daten per Index-Funktion übertragen

Dynamisches Tabellenblatt in Funktion

Index Funktion mit Platzhalter

Index und Aggregat Funktion

Korrigieren eines Fehlerwerts vom Typ Fehler in Index-/Übereinstimmungs Funktionen

INDEX (Funktion)

Funktion "Vergleich" nach Übereinstimmung durch Zeile ()+1 wiederholen