Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1368to1372
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

Markierte Zeilen über Makro Verknüpfen

Markierte Zeilen über Makro Verknüpfen
18.07.2014 11:54:14
Paulo
Hallo an Alle,
Ich benutze folgenden Code um Zeilen zu verknüpfen.
Wo bei in der ersten Spalte eine Nr steht und in der Zweiten Spalte die Nr von der ersten Splate mit der ich die Zeile Verknüpfen will.
Das Problem, das manchmal auftritt ist unerklärbar und zwar, schreibt er mir weiterhin die Formeln in die Zeilen nach dem die Makro gelaufen ist.
Das Seltsame ist das es nur manchmal auftritt.
Liegt es Vileicht am Code? Weis nicht wo der Fehler sein kann.
Sub ConectLink()
Dim a As Range
Dim LZeile As String
Dim Bereich As Range
LZeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
On Error Resume Next
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
Set Bereich = ThisWorkbook.Sheets("K").Range("C40:C" & LZeile)
For Each a In Bereich
If a  Empty Then
If a.Offset(0, -1).Value  a.Value Then
Range(a.Offset(0, 10), a.Offset(0, 17)).FormulaR1C1 = "=VLOOKUP(RC3,R40C2:R" _
& LZeile & "C20,R39C,0)"
Range(a.Offset(0, 10), a.Offset(0, 17)).Interior.ColorIndex = 43
Else
End If
Else
End If
Next
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
Set Bereich = Nothing
End Sub

----------------------------
Sub DisconectLink()
Dim a As Range
Dim LZeile As String
Dim Bereich As Range
LZeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
Set Bereich = ThisWorkbook.Sheets("K").Range("C40:C" & LZeile)
For Each a In Bereich
If a  Empty Then
If a.Offset(0, -1).Value  a.Value Then
Range(a.Offset(0, 10), a.Offset(0, 17)).ClearContents
Range(a.Offset(0, 10), a.Offset(0, 17)).Interior.ColorIndex = 0
Else
End If
Else
End If
Next
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
Set Bereich = Nothing
End Sub

Vielen Dank für die Hilfe
Paulo

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Markierte Zeilen über Makro Verknüpfen
20.07.2014 21:06:56
fcs
Hallo Paulo,
die beiden Makros können nur korrekt funktionieren, wenn das Blatt "K" bei der Ausführung das aktive Blatt ist.
Ist Blatt "K" nicht aktiv, dann wird der Wert von LZeile ggf. falsch berechnet.
Hier müssen die Bezüge für Cells, Range, Rows konsequent auf das gleiche/richtige Tabellenblatt (ich ehme an "K") gesetzt werden.
Gruß
Franz

Sub ConectLink()
Dim a As Range
Dim LZeile As String
Dim Bereich As Range
Dim wks As Worksheet
Set wks = ActiveWorkbook.Sheets("K") 'oder = ActiveSheet ?
'On Error Resume Next
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
With wks
LZeile = .Cells(.Rows.Count, 2).End(xlUp).Row
Set Bereich = .Range("C40:C" & LZeile)
For Each a In Bereich
If a  Empty Then
If a.Offset(0, -1).Value  a.Value Then
.Range(a.Offset(0, 10), a.Offset(0, 17)).FormulaR1C1 = "=VLOOKUP(RC3,R40C2: _
R" _
& LZeile & "C20,R39C,0)"
.Range(a.Offset(0, 10), a.Offset(0, 17)).Interior.ColorIndex = 43
Else
End If
Else
End If
Next
End With
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
Set Bereich = Nothing: Set wks = Nothing
End Sub
Sub DisconectLink()
Dim a As Range
Dim LZeile As String
Dim Bereich As Range
Dim wks As Worksheet
Set wks = ActiveWorkbook.Sheets("K") 'oder = ActiveSheet ?
'On Error Resume Next
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
With wks
LZeile = .Cells(.Rows.Count, 2).End(xlUp).Row
Set Bereich = .Range("C40:C" & LZeile)
For Each a In Bereich
If a  Empty Then
If a.Offset(0, -1).Value  a.Value Then
.Range(a.Offset(0, 10), a.Offset(0, 17)).ClearContents
.Range(a.Offset(0, 10), a.Offset(0, 17)).Interior.ColorIndex =  _
xlColorIndexNone '0
Else
End If
Else
End If
Next
End With
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
Set Bereich = Nothing: Set wks = Nothing
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige