Re: SVerweis im VBA
30.05.2002 17:25:38
Daniel R.
Hallo Nora
Grundsätzlich besteht die Möglichkeit, einen Sverweis per VBA zu programmieren. Das machst Du am besten so, indem Du beim Schreiben der Sverweis-Funktion den Makrorekorder laufen lässt. Anschliessend muss die Funktion noch in den gewünschten Code eingebaut werden. Nun ist es aber nicht unbedingt erforderlich, den Sverweis nach unten auszufüllen. Sinnvoller scheint es mir, wenn die gesuchte Information ausgehend von der Cursorposition eingesetzt wird.
Das Ganze ist allerdings nicht in wenigen Worten zu erklären. Ich übermittle Dir deshalb einen Auszug eines Codes, bei dem es nahezu um das gleiche Problem geht. Ausgehend von der Cursorposition wir mit Shift-Enter, nach Eingabe einer Artikelnummer der entsprechende Artikel links von der Cursoposition einglesen. Allerdings sucht Sverweis in zwei Tabellen (aktive bzw. passive Liste). Die Quelldatei hierfür heisst "Artikelliste". Versuche den Code mal nachzuvollziehen. Bei Fragen kannst Du dich ja nochmals melden.
Gruss Daniel R.Public Sub einlesen()
Dim spalte, zeile As Variant
Dim look, datei, pfad, pfad1, pfad2 As Variant
Dim blatt1, blatt2 As Variant
Dim wertverweis As Variant
look = "C:\Master" 'für LookIn, Quellverzeichnis Artikelliste
datei = "Artikelliste.xls" 'Name Artikelliste"
pfad = "'C:\Master\[Artikelliste.xls]" 'für Sverweis
blatt1 = "ROHSTOFFE 123'" 'Blattname 1
blatt2 = "ROHSTOFFE passiv'" 'Blattname 2
pfad1 = pfad + blatt1
pfad2 = pfad + blatt2
spalte = ActiveCell.Column
zeile = ActiveCell.Row
zeilenanfang = Sheets("Steuerdaten").Range("D1").Value
zeilenende = Sheets("Steuerdaten").Range("D2").Value
pruefspalte = Sheets("Steuerdaten").Range("D3").Value
'Suchen nach Artikelliste und Meldung wenn nicht vorhanden
With Application.FileSearch
.NewSearch
.LookIn = look
.SearchSubFolders = True
.Filename = datei
.MatchTextExactly = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute() = 0 Then
Beep
MsgBox "Die Artikelliste befindet sich nicht im erforderlichen Verzeichnis!" + Chr(13) + _
"Die Artikelnummer kann nicht eingelesen werden!" + Chr(13) + Chr(13) + _
"Kopieren Sie die Artikelliste in folgendes Verzeichnis:" + Chr(13) + Chr(13) + look, , Titel
Exit Sub
End If
End With
'Kontrolle Eingabebereich Artikelnummern
If spalte <> 8 Then 'pruefspalte Or zeile < zeilenanfang Or zeile > zeilenende Then
Beep
MsgBox "Cursor steht nicht im Bereich Artikelnummern!", , Titel
'Selection.ClearContents
Exit Sub
End If
ActiveSheet.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
Cells(zeile, 5).Select
'Verbindung Zellen wird aufgehoben
Selection.MergeCells = False
Cells(zeile, 5).Select
If Cells(zeile, 5).Value > "" Then
Cells(zeile, 5).Value = ""
End If
'Sverweis auf Artikelliste Rohstoffe 123
ActiveCell.FormulaR1C1 = _
"=IF(RC[+3]>0,IF(ISERROR(VLOOKUP(RC[+3]," & pfad1 & "!R5C1:R5000C2,2,FALSE)),""Falsche Nummer"",VLOOKUP(RC[+3]," & pfad1 & "!R5C1:R5000C2,2,FALSE)),"""")"
wertverweis = ActiveCell.Value
'Wenn Artikelnummer in Rohstoffe 123 nicht enthalten:
If wertverweis = "Falsche Nummer" Then
'Dann Sverweis auf Artikelliste Rohstoffe passiv
ActiveCell.FormulaR1C1 = _
"=IF(RC[+3]>0,IF(ISERROR(VLOOKUP(RC[+3]," & pfad2 & "!R5C1:R5000C2,2,FALSE)),""Falsche Nummer"",VLOOKUP(RC[+3]," & pfad2 & "!R5C1:R5000C2,2,FALSE)),"""")"
wertverweis = ActiveCell.Value
End If
Selection.ClearContents 'Sverweis-Formel wird gelöscht
ActiveCell.Value = wertverweis
Range(Cells(zeile, 5), Cells(zeile, 7)).Select
Selection.Merge
'Selection.ShrinkToFit = True
'Steuerwert für Eingabe Produktionsstufe wird gelöscht
Cells(zeile, 15).Value = ""
'ActiveCell.Offset(columnOffset:=3).Activate
Cells(zeile, 8).Activate
'ActiveCell.Offset(columnOffset:=3).Activate
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub