Anzeige
Archiv - Navigation
1444to1448
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

Fortsetzung: Eine bestimmte Zahl ersetzen

Fortsetzung: Eine bestimmte Zahl ersetzen
12.09.2015 07:15:54
erichm
(@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

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

Betreff
Datum
Anwender
Anzeige
AW: Fortsetzung: Eine bestimmte Zahl ersetzen
12.09.2015 09:54:35
Sepp
Hallo Erich,
so?
' **********************************************************************
' 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


Gruß Sepp

Anzeige
AW: Fortsetzung: Eine bestimmte Zahl ersetzen
12.09.2015 13:15:07
erichm
Hallo Sepp,
besten Dank - läuft super durch.
Habe das jetzt umfangreich und intensiv getestet. Wenn viele Reihen mit Dopplern zu tauschen sind, taucht die Zahl von D1 entsprechend oft auf.
Da wäre hilfreich, wenn beim Ersetzen zuerst D1, dann E1, F1, G1 usw.... verwendet wird, bis zu AI1 und dann wieder bei D1 begonnen wird.
Besten Dank wenn das auch noch möglich wäre.
mfg

AW: Fortsetzung: Eine bestimmte Zahl ersetzen
12.09.2015 13:23:27
Sepp
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

Anzeige
AW: Fortsetzung: Eine bestimmte Zahl ersetzen
12.09.2015 13:55:43
erichm
WAHNSINN - läuft perfekt!
Wieder mal besten Dank.
mfg

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige