Anzeige
Archiv - Navigation
1460to1464
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

Sverweis Spalten und Zeilen / SEPP !!!!

Sverweis Spalten und Zeilen / SEPP !!!!
11.12.2015 18:22:23
Tom
Hallo zusammen,
leider ist der Original-Thread von letzter Woche nicht mehr verfügbar, daher ein neuer.
Siehe auch https://www.herber.de/forum/archiv/1460to1464/t1462444.htm
Welchen Bereich muss ich ändern, damit nicht nur Zeile 2 und 3 geändert werden?
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim varRet As Variant
Dim lngC As Long, lngRow As Long
Dim CalculationMode As Long
On Error GoTo ErrorHandler
With Application
.ScreenUpdating = False
.EnableEvents = False
CalculationMode = .Calculation
.Calculation = xlManual
.DisplayAlerts = False
End With
If Target.Address(0, 0) = "B1" Then
For Each rng In Me.Range("B2:B" & Application.Max(2, Me.Cells(Me.Rows.Count, 2).End(xlUp).Row) _
)
If rng  "" Then
If SheetExist(rng.Text) Then
With Sheets(rng.Text)
varRet = Application.Match(Target, .Columns(1), 0)
If IsNumeric(varRet) Then
lngRow = varRet
For lngC = 3 To 22
varRet = Application.Match(Me.Cells(1, lngC), .Rows(1), 0)
If IsNumeric(varRet) Then
Me.Cells(rng.Row, lngC) = .Cells(lngRow, varRet)
Else
Me.Cells(rng.Row, lngC) = "#NA"
End If
Next
End If
End With
End If
End If
Next
End If
ErrorHandler:
With Err
If .Number  0 Then
MsgBox "Fehler in Prozedur:" & vbTab & "'nn'" & vbLf & String(25, "—") & _
vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
"Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
.Description & vbLf, 81968, "VBA - Fehler in Prozedur - collectData", .HelpFile, . _
HelpContext
.Clear
End If
End With
On Error GoTo 0
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalculationMode
.DisplayAlerts = True
.StatusBar = False
End With
End Sub

Private Function SheetExist(ByVal sheetName As String, Optional Wb As Workbook) As Boolean
Dim wks As Object
On Error GoTo ErrorHandler
If Wb Is Nothing Then Set Wb = ThisWorkbook
For Each wks In Wb.Sheets
If LCase(wks.Name) = LCase(sheetName) Then SheetExist = True: Exit Function
Next
ErrorHandler:
SheetExist = False
End Function

Gruß und Danke vorab
TOM

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Sverweis Spalten und Zeilen / SEPP !!!!
11.12.2015 18:44:33
Sepp
Hallo Tom,
der Code untersucht alle Zeilen, in denen in Spalte B ein Eintrag vorhanden ist!
Gruß Sepp

AW: Sverweis Spalten und Zeilen / SEPP !!!!
11.12.2015 18:55:27
Tom
Danke, zwischendurch hängt es.Aber funktioniert :-)
Gruß
TOM

AW: Sverweis Spalten und Zeilen / SEPP !!!!
12.12.2015 01:49:54
Sepp
Hallo Tom,
was hängt und wo?
Gruß Sepp

AW: Sverweis Spalten und Zeilen / SEPP !!!!
17.12.2015 08:41:25
Tom
HiSepp,
da es etwas sensible Daten sind, würde ich es Dir gerne pers. schicken.
Mailst Du mir Deine Adresse auf fraggle1973@web.de?
Wäre super
Danke!
Gruß
TOM

Anzeige
AW: Sverweis Spalten und Zeilen / SEPP !!!!
17.12.2015 18:52:37
Sepp
Hallo Tom,
dann anonymisiere die Daten und lade die Datei hier hoch.
Gruß Sepp

326 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige