Zwei Codes in einen zusammenführen
10.12.2015 11:23:00
Peter
Habe unteranderen die zwei unten stehenden Prozeduren in Tabelle1 mit Sub Worksheet_Change(ByVal Target as long) stehen. Jedoch "beissen" sich die zwei, die, die zuerst durchlaufen wird, funktioniert, die Nachvollgende dann nicht mehr. Tausche ich die beiden, ergibt das, dass gleiche Resultat.
Wie kann ich diese zwei Codes vereinen, so das beide in der gleichen Prozedur "Worksheet_Change (ByVal Target as long) funktionieren?
1. Code
' Suchen und Hyperlink öffnenü
Dim i As Integer 'Zeile mit DB-Nr.
If Target.Cells.Count {grösser als} 1 Then Exit Sub (musste das "grösser als Zeichen" durch den Text grösser als ersetzen, da es mit HTML dieser Website eine Fehlermeldung gab)
If Intersect(Range("G2"), Target) Is Nothing Then Exit Sub 'Suchfeld, Zelle für ACN-Nummer, hier ACN eingeben
On Error GoTo Errorhandler2
i = Application.WorksheetFunction.Match(Range("G2"), Range("E:E"), 0) 'Suchfeld, Zelle und Suchspalte, in dieser Spalte wird die ACN-Nummer gesucht
Cells(i, 18).EntireRow.Select 'Gesamte Zeile markieren
Application.Wait (Now + TimeValue("0:00:02")) 'Wartezeit
Cells(i, 11).Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True 'Spalte in der die PaCo-Id und Link steht, 9 Spalten von Links gezählt (Spalte F ist versteckt), in diesem Fall Spalte H, Hyperlink wird geöffnet, aktiviert
Exit Sub
Errorhandler2:
MsgBox "Datensatz oder Hyperlink nicht vorhanden"
Range("G2").Select
2. Code
'Leerzeichen in Strings Spalte G entfernen (zu diesem Code gehört die Funktion-Prozedur weiter unten "Function machs(Zelle)")
Dim Bereich As Range
Dim objZelle As Range
Dim bolEvents As Boolean
Set Bereich = Intersect(Target, Range("G4:G" & Rows.Count))
If Bereich Is Nothing Then Exit Sub 'Auf Bereich G4:G ganz unten
On Error GoTo Errorhandler
bolEvents = Application.EnableEvents
Application.EnableEvents = False 'Ereignissmakros ausschalten
For Each objZelle In Bereich
objZelle = machs(objZelle)
Next
Errorhandler:
Application.EnableEvents = bolEvents 'Ereignissmakros auf alte Einstellunb setzen
Vielen Dank für jede Unterstützung
Grüsse,
Peter