Thema Datum  Von Nutzer Rating
Antwort
07.04.2017 16:22:54 TanjaE
NotSolved
Blau Suchen und Ersetzen mit VBA
07.04.2017 16:57:28 BigBen
****
NotSolved
07.04.2017 17:43:16 TanjaE
NotSolved
07.04.2017 18:46:50 BigBen
NotSolved
08.04.2017 19:34:04 TanjaE
*****
NotSolved
09.04.2017 10:20:12 BigBen
*****
NotSolved
09.04.2017 22:01:52 TanjaE
NotSolved
10.04.2017 13:23:19 Gast63081
NotSolved

Ansicht des Beitrags:
Von:
BigBen
Datum:
07.04.2017 16:57:28
Views:
660
Rating: Antwort:
  Ja
Thema:
Suchen und Ersetzen mit VBA

Hallo,

ich würde es folgendermaßen lösen:

  1. Erstelle eine neue Tabelle, in der die korrekten Angaben enthalten sind. (Es kann auch eine ganz andere Arbeitsmappe sein)
  2. Ein Validierungs-Makro checkt die Angaben der Spalte BD und gibt bei Bedarf eine Warnung aus.

Validierungs-Makro:

Sub ValidateTische()
    Dim shSource As Worksheet ' Enthält korrekt Angaben
    Dim shDest As Worksheet ' Enthält zu prüfende Angaben
    Dim rng As Range
    
    Set shDest = ActiveWorkbook.Worksheets("Tabelle1")
    Set shSource = ActiveWorkbook.Worksheets("Tabelle2")
    
    For Each rng In Intersect(shDest.Range("BD:BD"), shDest.UsedRange)
        If Not rng.Value = shSource.Range(rng.Address).Value Then
            If rng.Row = 1 Then
                rng.Worksheet.Activate
                rng.Select
                MsgBox "Spalte nicht vorhanden", vbCritical
                Exit For
            Else
                rng.Value = shSource.Range(rng.Address).Value
            End If
        End If
    Next
End Sub

Die Tabellennamen müssen bei Bedarf angepasst werden.

Falls die korrekten Angaben in einer anderen Arbeitsmappe sein sollten, muss der VBA-Code angepasst werden:

Sub ValidateTische()
    Dim shSource As Worksheet ' Enthält korrekt Angaben
    Dim shDest As Worksheet ' Enthält zu prüfende Angaben
    Dim wbk As Workbook
    Dim rng As Range
    Set shDest = ActiveWorkbook.Worksheets("Tabelle1")
    Set wbk = Application.Workbooks.Open(ActiveWorkbook.Path & "\KorrekteTische.xlsx")
    Set shSource = wbk.Worksheets("Tabelle2")
    
    For Each rng In Intersect(shDest.Range("BD:BD"), shDest.UsedRange)
        If Not rng.Value = shSource.Range(rng.Address).Value Then
            If rng.Row = 1 Then
                rng.Worksheet.Activate
                rng.Select
                MsgBox "Spalte nicht vorhanden", vbCritical
                Exit For
            Else
                rng.Value = shSource.Range(rng.Address).Value
            End If
        End If
    Next
    wbk.Close
End Sub

In diesem Fall wird vorausgesetzt, dass die Arbeitsmappe "KorrekteTische.xlsx" im gleichen Verzeichnis vorhanden ist, wie die zu prüfende Arbeitsmappe.

Falls weitere Spalten überprüft werden sollen, kann die vorhandene Routine ohne weiteres ergänzt werden.

LG, BigBen


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
07.04.2017 16:22:54 TanjaE
NotSolved
Blau Suchen und Ersetzen mit VBA
07.04.2017 16:57:28 BigBen
****
NotSolved
07.04.2017 17:43:16 TanjaE
NotSolved
07.04.2017 18:46:50 BigBen
NotSolved
08.04.2017 19:34:04 TanjaE
*****
NotSolved
09.04.2017 10:20:12 BigBen
*****
NotSolved
09.04.2017 22:01:52 TanjaE
NotSolved
10.04.2017 13:23:19 Gast63081
NotSolved