Fortsetzung: Eine bestimmte Zahl ersetzen

(@Jochen: wie gewünscht ein neuer Thread)
Hallo,
die Problemlösung ist nahezu abgeschlossen; hier nochmal die Aufgabenstellung:
1. Durchsuche jede Zeile von B bis I (Zeilen 4 bis 123)
2. Prüfe ob eine Zahl pro Zeile doppelt vorkommt
3. Wenn keine Doppelte Zahl: nichts tun
4. Wenn eine Zahl doppelt, dann ersetze die erste oder zweite Doppelte mit einer Zahl aus der Range D1:AI1 die aber bisher nicht in dieser Reihe ist.
Aktuell arbeitet der Code so, dass in der Zeile die "doppelte zweite Zahl" gesucht wird (was richtig ist) und dann ab dieser Spalte alle folgenden Zahlen auch überschrieben werden (was nicht gewollt ist).
Die derzeitige Lösung ist in der Datei aufegezeigt, wobei ich folgendes vorbereitet habe:
1. Eine Tabelle "Ergebnis" bei der der Code bereits durchgelaufen ist und ich entsprechend die Zeilen markiert habe, bei denen "das Problem" erkennbar ist.
2. Mehrere Tabellen im "Originalzustand" um den Code testen zu können.
https://www.herber.de/bbs/user/100145.xlsm
Besten Dank nochmal.
mfg

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

' ********************************************************************** ' Modul: Modul1 Typ: Allgemeines Modul ' ********************************************************************** Option Explicit Sub chageNumbers() Dim rngReplace As Range, rng As Range Dim lngRow As Long, lngCol As Long With ActiveSheet Set rngReplace = .Range("D1:AI1") For lngRow = 4 To 123 For lngCol = 3 To 9 If Application.CountIf(.Range(.Cells(lngRow, 2), .Cells(lngRow, lngCol)), .Cells(lngRow, lngCol)) > 1 Then For Each rng In rngReplace If IsError(Application.Match(rng, .Range(.Cells(lngRow, 2), .Cells(lngRow, 9)), 0)) Then .Cells(lngRow, lngCol) = rng Exit For End If Next End If Next Next End With End Sub

Hallo Erich,
auch kein Problem.

' **********************************************************************
' Modul: Modul1  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub chageNumbers()
Dim vntReplace As Variant
Dim lngRow As Long, lngCol As Long, lngI As Long

With ActiveSheet
  vntReplace = .Range("D1:AI1")
  For lngRow = 4 To 123
    For lngCol = 3 To 9 'zweiten Doppler ersetzen
      If Application.CountIf(.Range(.Cells(lngRow, 2), .Cells(lngRow, lngCol)), .Cells(lngRow, lngCol)) > 1 Then
        Do
          lngI = lngI + 1
          If lngI > UBound(vntReplace, 2) Then lngI = 1
          If IsError(Application.Match(vntReplace(1, lngI), .Range(.Cells(lngRow, 2), .Cells(lngRow, lngCol)), 0)) Then
            .Cells(lngRow, lngCol) = vntReplace(1, lngI)
            Exit Do
          End If
        Loop While lngI <= UBound(vntReplace, 2)
      End If
    Next
  Next
End With

End Sub

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

Fortsetzung: Eine bestimmte Zahl ersetzen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread