Hallo,

etwas unverständlich und da das Makro nicht vollständig, nich alles nachvollziehbar



warum setzt du nicht die Werte des Zellbereichs ein

For i = X13zeile To x13zeile + 3
For j = xspalte+1 To xspalte + 5

Gruß

Helmut

hallo helmut,

danke für deine antwort, aber ich glaube dass dein tipp genau das gleiche bewirkt wie meins bzw dass es nichts anderes ist.

also dieser zellbereich umfasst ja 18 zellen (3*6), aber in diesen zellen die vorher in ein excel sheet ausgelesen werden (aus einer datei) können auch leere zellen dabei sein und dann macht mein obiges makro eben gar nichts.

dein vorschlag ist ja dann (glaube ich) auch inklusive den zellen ohne werte und würde dann quasi auch nicht zum ziel führen.

oh sorry, glaub da hab ich am ende noch was mit rein kopiert was nicht dazu gehört, aber nur das in der mitte ist relevant.

hast du noch eine idee?

mfg
seebaer

hallo,

wird durch deine Erläuterung in AW 2 nur noch unverständlicher was du willst / vorhast

Gruß

Helmut

Hallo seebaer_1,
ich verstehe deinen Code zwar auch nicht ganz, aber vielleicht meinst du ja sowas:
Ausdruck.SpecialCells(Type, Value)
mit Type = xlCellTypeConstants
und value = xlLogical, xlNumbers oder xlTextValues.
Gibt ein Range-Objekt zurück, das alle Zellen darstellt, die mit dem angegebenen Wert übereinstimmen.

Leere Zelllen müssten damit entfallen, weil die mit xlCellTypeBlanks angesprochen werden.
Also sollte das denn so aussehen:

Cells(i, j).SpecialCells(xlCellTypeConstants, xlNumbers ).value

Gruß
lorf

PS: Für die Minimum-Suche würde ich eine Function machen mit der Zell-Adresse als Parameter. Man findet sich denn besser zurecht.

hallo zusammen,

erstmal danke für eure mühen, vllt ist es ja so verständlicher was ich meine:

hier ein etwas ausführlicherer teil meines makros:

Windows(imuiworkbook).Activate
xzeile = 1
xspalte = 1
lfound = False
zzeile = 520
zspalte = 10
yzeile = 520
yspalte = 1

.Cells(xzeile, xspalte).Select
Do Until lfound
xzeile = xzeile + 1
If .Cells(xzeile, xspalte).Value = "EXEC" Then
lfound = True
Else
Windows(imuiworkbook).Activate
If .Cells(xzeile, xspalte).Value = "331" Then
.Range(Cells(xzeile, xspalte + 1), Cells(xzeile + 3, xspalte + 6)).Select
.Range(Cells(xzeile, xspalte + 1), Cells(xzeile + 3, xspalte + 6)).Copy
Windows(kmappe).Activate
Sheets("Muster").Activate
ActiveSheet.Cells(yzeile, yspalte).Select
ActiveSheet.Paste
If Range("B7").Value = "1" Then
festerWert = 0
Min = Range("A400").Value
Wert = Range("A400").Value
For i = yzeile To yzeile + 3
For j = yspalte To yspalte + 5
If Abs(Range("A400").Value - Cells(i, j).Value) < Min Then
Min = Abs(Range("A400").Value - Cells(i, j).Value)
Wert = Cells(i + 2, j).Value
End If
Next j
Next i
If Range("B7").Value = "1" Then
Range("B9").Value = Wert
Range("B10").Value = festerWert
End If
If Range("B7").Value = "0" Then
Range("B10").Value = Wert
Range("B9").Value = festerWert
End If
End If
If Range("C7").Value = "1" Then
festerWert = 0
Min = Range("B400").Value
Wert = Range("B400").Value
For i = yzeile To yzeile + 3
For j = yspalte To yspalte + 5
If Abs(Range("B400").Value - Cells(i, j).Value) < Min Then
Min = Abs(Range("B400").Value - Cells(i, j).Value)
Wert = Cells(i + 2, j).Value
End If
Next j
Next i
If Range("C7").Value = "1" Then
Range("C9").Value = Wert
Range("C10").Value = festerWert
End If
If Range("C7").Value = "0" Then
Range("C10").Value = Wert
Range("C9").Value = festerWert
End If
End If
yzeile = yzeile + 5
Windows(imuiworkbook).Activate
lfound = True
End If
End If
Loop
x1zeile = 1
lfound = False
Do Until lfound
x1zeile = x1zeile + 1
If .Cells(x1zeile, xspalte).Value = "EXEC" Then
lfound = True
Else
Windows(imuiworkbook).Activate
If .Cells(x1zeile, xspalte).Value = "311" Then
.Range(Cells(x1zeile, xspalte + 1), Cells(x1zeile + 3, xspalte + 6)).Select
.Range(Cells(x1zeile, xspalte + 1), Cells(x1zeile + 3, xspalte + 6)).Copy
Windows(kmappe).Activate
Sheets("Muster").Activate
ActiveSheet.Cells(zzeile, zspalte).Select
ActiveSheet.Paste
If Range("B7").Value = "0" Then
festerWert = 0
Min = Range("A400").Value
Wert = Range("A400").Value
For i = zzeile To zzeile + 3
For j = zspalte To zspalte + 5
If Abs(Range("A400").Value - Cells(i, j).Value) < Min Then
Min = Abs(Range("A400").Value - Cells(i, j).Value)
Wert = Cells(i + 2, j).Value
End If
Next j
Next i
If Range("B7").Value = "1" Then
Range("B9").Value = Wert
Range("B10").Value = festerWert
End If
If Range("B7").Value = "0" Then
Range("B10").Value = Wert
Range("B9").Value = festerWert
End If
End If
If Range("C7").Value = "0" Then
festerWert = 0
Min = Range("B400").Value
Wert = Range("B400").Value
For i = zzeile To zzeile + 3
For j = zspalte To zspalte + 5
If Abs(Range("B400").Value - Cells(i, j).Value) < Min Then
Min = Abs(Range("B400").Value - Cells(i, j).Value)
Wert = Cells(i + 2, j).Value
End If
Next j
Next i
If Range("C7").Value = "1" Then
Range("C9").Value = Wert
Range("C10").Value = festerWert
End If
If Range("C7").Value = "0" Then
Range("C10").Value = Wert
Range("C9").Value = festerWert
End If
End If
zzeile = zzeile + 5
lfound = True
End If
End If
Loop


Mir geht es jetzt um das makro von
Min = Range("A400").Value
bis
Next i

dieser kleine teil soll geändert werden.

der bereich zzeile+3 bis zspalte + 6 bzw yzeile + 3 bis yspalte + 6 umfasst den bereich der durchsucht werden soll.
der bereich umfasst 18 zellen(3*6)
aber einige dieser zellen können thoeretisch auch leer sein, und dann funktioniert das bisherige "Vergleichs- Rausschreibmakro" nicht mehr.

meine frage ware wie man

Min = Range("B400").Value
Wert = Range("B400").Value
For i = yzeile To yzeile + 3
For j = yspalte To yspalte + 5
If Abs(Range("B400").Value - Cells(i, j).Value) < Min Then
Min = Abs(Range("B400").Value - Cells(i, j).Value)
Wert = Cells(i + 2, j).Value
End If
Next j
Next i

änderen muss damit das dann klappt.

danke
mfg seebaer