Code verbessern/lesbarer machen
03.03.2017 10:14:10
Max2
der Code der unten folgt überprüft eine Eingabe in Spalte F und sucht in einem entsprechenden Tabellenblatt dann nach dem Eingegebenen Begriff.
Anschließend werden die Daten rechts neben dem Treffer in das Vorlagen Blatt eingefügt.
Ich mache das ganze über Worksheet_Change mit einigen If-Bedingungen.
Mein Worksheet_Change Code gefällt mir aber ganz und gar nicht...
Habt ihr Vorschläge für mich?
Worksheet_Change Sub:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim name As String
Dim x As Variant
Dim i
Dim check As Variant
x = Array(1, 1, 3)
check = Array("H", "P", "EUH")
On Error Resume Next
'//Name des aktive Sheets
name = ActiveSheet.name
'//Falls Zelle in Spalte F dann
If Target.Column = 6 Then
'//Falls Target im Bereich xy dann
If Target.Row >= 47 And Target.Row "" Then
For i = 0 To 2
'//Prüfe ob Target ein Datensatz ist
If Left(Target.Value, x(i)) = check(i) Then
Call verkleinern_feld(Target.Row, Target.Column)
End If
Next i
Else
End If
End If
'//Falls Zelle zwischen Zeile 13 u. 56 dann
If Target.Row > 12 And Target.Row Sub der Daten holt (gibt es drei mal, sieht aber immer 99% gleich aus):
Option Explicit
Sub H(ByRef intR As Integer, _
ByRef intC As Integer, _
ByRef name As String, _
ByRef wsN As String)
Dim ws As Worksheet
Dim ws_2 As Worksheet
Dim rng As Range
Dim x As Integer, y As Integer
Dim datenSatz As String
Dim sname As String
Dim i As Integer
Dim lzeile As Long
Application.ScreenUpdating = False
'//Tabellen aus denen Wir Daten holen bzw. einfügen
Set ws = ThisWorkbook.Sheets(wsN)
Set ws_2 = ThisWorkbook.Sheets("H")
'//Datenbank Tabelle
With ws_2
'//Name des gesuchten Datensatzes
sname = name
lzeile = .Cells(.Rows.Count, 2).End(xlUp).Row
'//Range setzen und anschließend durchsuchen
'//in i wird lediglich die Zeile gespeichert
Set rng = .Range(.Cells(2, 2), .Cells(lzeile, 2))
i = rng.Find(What:=sname, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext).Row
'//Jetzt holen wir uns den Datensatz neben dem Treffer
datenSatz = .Cells(i, 3).Value
End With
With ws
x = intR
y = intC
.Cells(x, y + 4).Value = datenSatz
End With
Application.ScreenUpdating = True
End Sub
Sub der Zellen verbindet:
Option Explicit
Sub verkleinern_feld(ByRef x As Integer, _
ByRef y As Integer)
Dim ws As Worksheet
Dim rng As Range
Dim i
Application.ScreenUpdating = False
i = 56 - x
Set ws = ThisWorkbook.Sheets("Vorlage_Vorne")
With ws
Set rng = .Range(.Cells(x + 1, y), .Cells(x + 1, y + 20))
rng.MergeCells = False
Set rng = .Range(.Cells(x + 1, y), .Cells(x + 1, y + 3))
rng.MergeCells = True
Set rng = .Range(.Cells(x + 1, y + 4), .Cells(x + 1, y + 20))
rng.MergeCells = True
Set rng = .Range(.Cells(x + 2, y), .Cells(x + i, y + 20))
rng.MergeCells = True
End With
Application.ScreenUpdating = True
End Sub