Microsoft Excel

Herbers Excel/VBA-Archiv

Sverweis nach eine X | Herbers Excel-Forum


Betrifft: Sverweis nach eine X von: Karel
Geschrieben am: 25.10.2008 20:06:43

Hallo und Guten abend,

mit folgende Code wird ein Sverweis durch Doppelklick in Spalte D gesetzt

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim var As Variant
    If Target.Column <> 4 Then Exit Sub
    With Application
    var = .VLookup(Target.Value, _
       Worksheets("Training").Columns("A:B"), 2, 0)
    If Not IsError(var) Then
       Target.Offset(0, 1) = .VLookup(Target.Value, _
          Worksheets("Training").Columns("A:B"), 2, 0)

    End If
    End With
 End Sub



Tabelle1

 ABCDEFGHIJK
1DatumTagXNr.ProgrammDatum  XNr.ProgrammDatum
201.01.Mo TD    TD  
3Neujahr XRDRuhiger Dauerlauf25.10.2008 XRDRuhiger Dauerlauf25.10.2008
402.01.Di MD    MD  
5  XFDFlotter Dauerlauf25.10.2008  FD  
603.01.Mi LD   XLDLanger Dauerlauf25.10.2008
7   FS    FS  
804.01.DoXITIntensiver Tempolauf25.10.2008  IT  
9   ET    ET  
1005.01.Fr T62   XT626x200025.10.2008
11   T62    T62  


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4

Mochte gerne durch setzen von eine "X" in Spalte C und H Sverweis auslösen

Habe dass probiert mit folgende Code aber ohen Erfolg

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim var As Variant
'Code in das entsprechende Tabellenblatt
If Not Intersect(Target, Range("C3:C50;H3:H50")) Is Nothing And Target.Count = 1 Then
  If LCase(Target) = "meine eingabe" Then
       If Target.Column <> 4 Then Exit Sub
    With Application
    var = .VLookup(Target.Value, _
       Worksheets("Training").Columns("A:B"), 2, 0)
    If Not IsError(var) Then
       Target.Offset(0, 1) = .VLookup(Target.Value, _
          Worksheets("Training").Columns("A:B"), 2, 0)
          
End If

       If Target.Column <> 8 Then Exit Sub
    With Application
    var = .VLookup(Target.Value, _
       Worksheets("Training").Columns("A:B"), 2, 0)
    If Not IsError(var) Then
       Target.Offset(0, 1) = .VLookup(Target.Value, _
          Worksheets("Training").Columns("A:B"), 2, 0)
          
  End If
End If
End Sub



wer weis bescheid

Grusse
Karel

  

Betrifft: AW: Sverweis nach eine X von: Gerd L
Geschrieben am: 25.10.2008 22:40:39

Hallo Karel,

ungetestet:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim var As Variant
    If Target.Column = 3 Or Target.Column = 8 Then
    If Target.Count = 1 Then
    If UCase(Target.Value) = "X" Then
    
    With Application
    var = .VLookup(Target.Offset(1, 0).Value, _
       Worksheets("Training").Columns("A:B"), 2, 0)
    If Not IsError(var) Then
       Target.Offset(0, 2) = .VLookup(Target.Offset(1, 0).Value, _
          Worksheets("Training").Columns("A:B"), 2, 0)

    End If
    End With
    
    End If
    End If
    End If
End Sub



Gruß Gerd


  

Betrifft: AW: Sverweis nach eine X von: Karel
Geschrieben am: 26.10.2008 18:01:40

Hallo Gerd,

Habe deine Code eingebaut und Probiert, aber igendwie Funktioniert es nicht.

wass mache ich falsch

habe Beispiel mit Tabelle Variante 1 und Variante 2 (Dein Code)hinzugefügt
dass ist Variante 2 brauchen ich.

https://www.herber.de/bbs/user/56302.xls


Grusse

Karel


  

Betrifft: AW: Sverweis nach eine X von: Reinhard
Geschrieben am: 27.10.2008 10:50:25

Hi Karel,

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim var As Variant
If Target.Column <> 3 And Target.Column <> 8 Then Exit Sub
If Target.Count <> 1 Then Exit Sub
Application.EnableEvents = False
With Application.WorksheetFunction
   If UCase(Target.Value) = "X" Then
      If .CountIf(Worksheets("Training").Columns(1), Target.Offset(0, 1).Value) > 0 Then
         Target.Offset(0, 2) = .VLookup(Target.Offset(0, 1).Value, _
            Worksheets("Training").Columns("A:B"), 2, 0)
         Target.Offset(0, 3) = Worksheets("Training").Range("D1")
      End If
   Else
      Target.Offset(0, 2) = ""
      Target.Offset(0, 3) = ""
   End If
End With
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column <> 3 And Target.Column <> 8 Then Exit Sub
If Target.Count <> 1 Then Exit Sub
If Target.Row = 1 Or Target.Row > 500 Then Exit Sub
Target.Value = IIf(Target.Value = "X", "", "X")
Cells(ActiveCell.Row + 1, ActiveCell.Column + 1).Activate
End Sub


Gruß
Reinhard


  

Betrifft: AW: Danke und o.t. von: Karel
Geschrieben am: 29.10.2008 20:55:42

Hallo Reinard,

ich war unterwegs und könnte erst jetzt deine Code testen.
Perfekt und danke nochmalls für Mausklick X

Viele Gruße und Dankeschön, Karel


Beiträge aus den Excel-Beispielen zum Thema "Sverweis nach eine X"