Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 19:29:30
24.04.2024 18:49:56
24.04.2024 17:19:09
Anzeige
Archiv - Navigation
1464to1468
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

VBA Code

VBA Code
07.01.2016 14:02:02
Sentel
Hallo zusammen und allen ein Frohes neues Jahr.
Nun hattet ihr ja ein wenig Ruhe vor mir, doch stehe ich nun wieder vor einem Problem welches ich durch Recherche einfach nicht lösen kann.
Den folgenden Code möchte ich gerne für eine Tabelle bis zur Zeile 400 Kopieren, also so dass falls in einer Zeile ein x steht die dazugehörige Zelle in eine andere kopiert wird.Ich könnte dies ja 400 mal eingeben, aber da wird es doch was kürzeres geben oder?
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("I5").Value = "X" Or Range("I5").Value = "x" Then
Range("I5").ClearContents
Range("H5").Select
Selection.Copy
Range("G5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End Sub
Also soll dies hier nicht nur für Zeile 5, sondern für alle Zeilen bis Zeile 400 gelten. Ich hoffe mein Vorhaben wird deutlich.
Danke für eure Hilfe.
Gruß Sentel

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Code
07.01.2016 14:32:42
ede
Hallo Sentel,
dann erweitere doch einfach den Bereich von H5 auf H5:H400.
Range("H5:H400").Select
Gruss

AW: VBA Code
07.01.2016 14:40:29
Sentel
Hallo Ede,
das funktioniert leider so nicht. Die Berechnung soll immer für jede Zeile einzeln gelten. Also
wenn I5=x dann kopiere H5 zu G5
wenn I6=x dann Kopiere H6 zu G6
wenn I7=x dann kopiere H7 zu G7 usw.
und dies soll bis Zeile 400 durchlaufen.
Gruß Sentel

AW: VBA Code
07.01.2016 14:47:59
ede
oh, hatte ich falls verstanden, dann schau mal so:
Private Sub Worksheet_Change(ByVal Target As Range)
If UCase(Cells(Target.Row, 9)) = "X" Then
Cells(Target.Row, 9) = ""
Cells(Target.Row, 7) = Cells(Target.Row, 8)
End If
End Sub

Anzeige
AW: VBA Code
07.01.2016 14:52:19
Sentel
Hallo Ede,
das ist ja göttlich!!!! Genau ds was ich brauchte.
Ich danke dir vielmals
Gruß Sentel

AW: VBA Code
07.01.2016 14:53:44
Robin
Hallo Sentel,
ich hätte das ganze (zugegeben unelegant) mit einer Schleife gelöst, vielleicht hilft es dir ja weiter.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Integer 'Variable festlegen
i = 4 'Variable füllen
Do Until i = 400 'Ende der Schleife festlegen
If Cells(i, 9) = "x" Then
Cells(i, 9).Clear
Cells(i, 7).Value = Cells(i, 8).Value
End If
i = i + 1 'Schleifenvariable um 1 erhöhen
Loop
End Sub
Gruß, Robin

Anzeige
AW: VBA Code
07.01.2016 14:59:36
ede
Hallo Robin,
dann wird aber mit jeder Änderung in einer Zelle deine Schleife 400* durchlaufen, dass wäre bestimmt nicht angebracht!!!!!

AW: VBA Code
07.01.2016 15:13:42
Robin
Hallo Ede,
da hast du natürlich recht, aber war dies nicht die Intention von Sentel? Eventuell besteht ja im konkreten Fall auch die Möglichkeit um "Worksheet_SelectionChange" herumkommen, indem man das ganze einmalig per Button oder ähnlichem auslöst, wobei die Schleife nur einmal von 4-400 durchlaufen wird.
Grüße,
Robin

macht natürlich mehr Sinn o.T.
07.01.2016 15:17:36
ede
.

AW: VBA Code
08.01.2016 11:24:59
Sentel
Hallo zusammen,
soweit war der Code genau das was ich gesucht habe und funktioniert tadellos.
Nun hat sich leider eine Änderung ergeben und in die Zellen der Spalte soll jetzt ein Datum (immer unterschiedlich) eingegeben werden und nach der Eingabe in die Zelle der gleichen Zeile (nur 2 Spalten vorher) eingetragen werden. Danach soll das eingegebene Datum gelöscht werden.
Ich bekomme es nicht hin, aber ihr mit Sicherheit.
Danke schonmal

Anzeige
AW: VBA Code
08.01.2016 12:05:09
ede
Hallo noch mal,
hier mit Prüfung auf Datum statt auf "X", den zweiten Teil solltest Du ableiten können.

Private Sub Worksheet_Change(ByVal Target As Range)
If IsDate(Cells(Target.Row, 9)) Then
Cells(Target.Row, 9) = ""
Cells(Target.Row, 7) = Cells(Target.Row, 8)
End If
End Sub

Gruss

AW: VBA Code
08.01.2016 12:31:12
Sentel
Hallo Ede,
hab es jetzt so angepasst, falls noch eine Änderung kommt. So kann ja nun alles eingegeben werden.
Private Sub Worksheet_Change(ByVal Target As Range)
If UCase(Cells(Target.Row, 9))  "" Then
Cells(Target.Row, 7) = (Cells(Target.Row, 9))
Cells(Target.Row, 5) = ""
Cells(Target.Row, 9) = ""
End If
End Sub
Die Zelle in Spalte 9 die beschrieben wird soll übertragen werden in die gleiche Zeile in Spalte 7,
danach soll die Zelle in Spalte 9 wieder gelöscht werden und zeitgleich auch die Zelle in Spalte 5.
Bei diesem Code stürzt Excel regelmäßig ab.
Wenn ich aber die letzten beiden Befehle rausnehme funktioniert zumindest die Übernahme von Spalte 9 zu Spalte 7.
Ich verzweifle hier noch.
Gruß Sentel

Anzeige
AW: VBA Code
08.01.2016 12:37:44
ede
du musst über eine Hilfsvariable gehen, dann stürzt Excel nicht ab, anbei noch mal mein Beispiel...

Private Sub Worksheet_Change(ByVal Target As Range)
If IsDate(Cells(Target.Row, 9)) Then
dummy = Target
Cells(Target.Row, 9) = ""
Cells(Target.Row, 7) = Cells(Target.Row, 8)
Cells(Target.Row, 6) = dummy
End If
End Sub

AW: VBA Code
08.01.2016 12:53:33
Sentel
Hallo,
leider funktioniert das irgendwie nicht. Excel stürzt immer noch ab. Aber so ganz klar ist mir das mit der Hilfsvariablen leider nicht. Hier nochmal mein Code. Als Hilfsvariable habe ich nun Spalte 10 genommen, in der ansonsten nichts steht. Tut mir wirklich leid das ich bei dem Thema so benagelt bin.
Private Sub Worksheet_Change(ByVal Target As Range)
If UCase(Cells(Target.Row, 9))  "" Then
dummy = Target
Cells(Target.Row, 7) = (Cells(Target.Row, 9))
Cells(Target.Row, 5) = ""
Cells(Target.Row, 9) = ""
Cells(Target.Row, 6) = dummy
End If
End Sub

Anzeige
AW: VBA Code
11.01.2016 14:03:46
ede
so:

Private Sub Worksheet_Change(ByVal Target As Range)
If UCase(Cells(Target.Row, 9))  "" Then
dummy = Target
Cells(Target.Row, 6) = dummy
Cells(Target.Row, 7) = dummy
Cells(Target.Row, 5) = ""
Cells(Target.Row, 9) = ""
End If
End Sub

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige