Kopier Bedingung mit VBA

[veniceline]

Hallo Zusammen,

ich habe ein kleines Makro, welches wenn aufgerufen wird eine Reihe an Daten in eine andere kopiert. Das funktioniert auch soweit.

Nun möchte ich dies erweitern und dem Makro sagen, das es nur Werte in leere Zellen kopieren darf, oder in Zellen die kleiner als Wert 1 sind. (also wenn leer oder eine Null in der Zelle steht, darf es kopieren)

In der Praxis sieht es dann so aus, das beim Ausführen des Makros, es in einige Zellen einen Wert kopiert und in andere Zellen nicht, da hier bereits ein Wert grösser 1 vorhanden ist.



Hier das funktionierende Makro:

Sub Woche_1()
'
' Woche_1 Makro
' Kopiert die Werte in Spalte Woche 1.
'
' Tastenkombination: Strg+h
'
    Range("J7:J30").Select
    Selection.Copy
    Range("K7:K30").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("M14").Select
    Application.CutCopyMode = False
End Sub



Vielen Dank schon mal im Voraus :19: 

Gruss Torsten

[Mase]

Hi Torsten,

welche Möglichkeiten, um Bedingungen zu prüfen, hast Du bei deiner Recherche finden können?



gruß
Marco

[schauan]

Hallöchen,

da müsstest Du jeden Zellinhalt einzeln abgleichen. Normalerweise nimmst Du beide Bereiche in je ein Array, ersetzt ggf. die Daten bei leer oder 0 und schreibst das geänderte Array zurück. Bei kleinen Bereichen kann man auch mal zellenweise vorgehen.

…
for iCnt = 7 to 30
if cells(iCnt,11).value = "" or cells(icnt,11).value < 1 then cells(icnt,11).value = cells(icnt,10).value
next
...

[veniceline]

Danke ich teste das mal nächste Woche
ich glaube 

for each geht auch als Schleife...

Bei mir steht entweder nichts in der Zelle oder eine 0 (NULL). Diese dürfen mit Werten versehen werden. 
Bei denen wo schon was drinn steht soll erhalten bleiben, also nicht überschreiben.

grüsse und schönes Wochenende

[EasY]

Hi, 

da mir - was VBA angeht - Arrays bislang unzugänglich waren habe ich sowas ähnliches mal ganz plakativ gelöst: 

Ich habe beide zu vergleichenden Bereiche in ein ausgeblendetes Blatt in jeweiles eine Spalte kopiert und dann mittels Formel in einer dritten Spalte die Bedingungen dargestellt. Das Ergebnis habe ich dann wieder zurück in die eigentliche Tabelle kopiert (nur die Werte, nicht die Formel).

Sicher gibt es flottere und elegantere Varianten aber ich denke so klappt das und ist auch nicht besonders schwierig umzusetzen. Das wäre auch mittels Makrorecorder möglich. 

Nur als Idee, vielleicht hilft dir das ja :)

[RPP63]

Moin!
@EasY:
Das mit den Arrays ist ja kein Hexenwerk.
Wenn ich einem Array den Bereich Range("J7:J20") übergebe,
dann erhalte ich das Array arr(1 To 14, 1 To 1)
Dann kann ich dieses Array mittels For i = 1 To 14 oder allgemeiner mit For i = 1 To UBound(arr) durchschleifen.

Ausgangsposition:

	J	K
7	1	1
8	2	0
9	2	3
10	3	3
11	1
12	1	1
13	1	2
14	2	1
15	2
16	2	1
17	2	0
18	3	3
19	2
20	3	1

Makro:

Sub Woche_1()
Dim Quell_arr, Ziel_arr
Dim i&
With Tabelle1
  Quell_arr = .Range("J7:J20")
  Ziel_arr = .Range("K7:K20")
  For i = 1 To Ubound(Quell_arr)
    If Ziel_arr(i, 1) < 1 Then Ziel_arr(i, 1) = Quell_arr(i, 1)
  Next
  .Range("K7:K20") = Ziel_arr
End With
End Sub

Ergebnis:

	J	K
7	1	1
8	2	2
9	2	3
10	3	3
11	1	1
12	1	1
13	1	2
14	2	1
15	2	2
16	2	1
17	2	2
18	3	3
19	2	2
20	3	1

Gruß Ralf

[veniceline]

Hallo Ralf,

vielen Dank! - das funktioniert bestens.

[snb]

Oder:

Code:

Sub M_snb()
   [K7:K20] = [if(K7:K20<1,J7:J20,K7:K20)]
End Sub