auslesen, hyperlink, doppelte loeschen.

Bild

Betrifft: auslesen, hyperlink, doppelte loeschen.
von: th.heinrich
Geschrieben am: 04.11.2003 18:25:31

bestes Forum,

der betreff ist schwer zu umschreiben, aber folgendes soll ablaufen.

es werden daten in ein WORKSHEET eigelesen, dabei soll in SPALTE U ein HYPERLINK erzeugt werden.


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim rng As Range
'ActiveSheet.Unprotect "ni7888"
    Application.ScreenUpdating = False
    For Each rng In Range("u2").CurrentRegion.Cells
        If Right(rng.Value, 4) = ".xls" Then
        rng.Hyperlinks.Add rng, rng.Value
    End If
    Next rng
    Application.ScreenUpdating = True
End Sub


klappt auch soweit. nach aufruf des HYPERLINKS wird die datei geoeffnet, damit der user sie einsehen kann. beim schliessen wird die datei erneut ausgelesen, soll heissen im AUSWERTUNGSSHEET kommt sie doppelt vor.

dies will ich wie folgt verhindern.


Private Sub Workbook_Beforeclose(Cancel As Boolean)
Application.ScreenUpdating = False
   With ActiveSheet.UsedRange
   '.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
   Range("A2").CurrentRegion.AdvancedFilter _
      Action:=xlFilterCopy, CopyToRange:= _
      Cells(1, .Columns.Count + 1), Unique:=True
   'Columns.CurrentRegion.EntireColumn.Delete
      .EntireColumn.Delete
   End With
   Application.ScreenUpdating = True
Columns.AutoFit
'ActiveSheet.Protect "ni7888"
End Sub


es werden auch DOPPELTE DATENSÄTZE gelöscht, leider mit dem nachteil, dass im AUSWERTUNGSSHEET die SPALTEN J,L,N,P,R durch H ueberschrieben werden.

siehe beispielmappe.

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

sorry fuer den umfang des posting und dank an alle die bisher geholfen haben bzw. noch helfen werden (hoffnung).

gruss thomas
Bild


Betrifft: loesung
von: th.heinrich
Geschrieben am: 05.11.2003 15:27:11

bestes Forum,

mit diesem etwas abgewandelten CODE von WernerB

Option Explicit

Sub DoppelteRaus()
Dim SuBe As Range
Dim i As Long, laR As Long
    Application.ScreenUpdating = False
    laR = Cells(Rows.Count, 6).End(xlUp).Row
    For i = laR To 2 Step -1
      laR = Cells(Rows.Count, 6).End(xlUp).Row
      Set SuBe = ActiveSheet.Range(Cells(1, 6), Cells(i - 1, 6)) _
                .Find(Cells(i, 6), lookat:=xlWhole)
      If Not SuBe Is Nothing Then
        SuBe.EntireRow.Delete
      End If
    Next i
    Application.ScreenUpdating = True
End Sub


konnte ich das prob loesen.

gruss thomas


Bild

Beiträge aus den Excel-Beispielen zum Thema " auslesen, hyperlink, doppelte loeschen."