Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1660to1664
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

Doppelter Transfer verhindern

Doppelter Transfer verhindern
16.12.2018 17:33:21
Roger
Hallo
Leider habe ich noch einen Fehler gefunden.
Wie kann ich verhindern in dem folgenden Script dass mehrmals der gleiche Eintrag im Tabellenblatt eingetragen wird?
Sub uebertrag()
Dim name(1 To 5) As String
Worksheets("Maske").Select
Name1 = Range("K10")
Name2 = Range("K12")
Name3 = Range("K14")
Name4 = Range("K16")
Name5 = Range("K18")
Worksheets("Aufträge gesammt").Select
Worksheets("Aufträge gesammt").Range("A4").Select
If Worksheets("Aufträge gesammt").Range("A4").Offset(1, 0)  "" Then
Worksheets("Aufträge gesammt").Range("A4").End(xlDown).Select
End If
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = Name1
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Name2
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Name3
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Name4
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Name5
End Sub

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Doppelter Transfer verhindern
16.12.2018 20:12:50
onur
Nix für ungut, aber der Code ist Müll.
Was willst du wohin schreiben und wann?
AW: Doppelter Transfer verhindern
16.12.2018 20:30:10
Gerd
Moin
Sub uebertrag()
Dim arstrName(1 To 5) As String
Dim i As Long, zeile As Long
With Worksheets("Maske")
arstrName(1) = .Range("K10")
arstrName(2) = .Range("K12")
arstrName(3) = .Range("K14")
arstrName(4) = .Range("K16")
arstrName(5) = .Range("K18")
End With
With Worksheets("Aufträge gesamt")
zeile = 4
If .Range("A5")  "" Then zeile = .Range("A4").End(xlDown).Row
For i = 1 To 5
If WorksheetFunction.CountIf(.Range(.Cells(5, 1), .Cells(zeile, 1)), arstrName(i)) = 0  _
Then
zeile = zeile + 1
.Cells(zeile, 1) = arstrName(i)
End If
Next
End With
Erase arstrName
End Sub

Gruß Gerd
Anzeige
AW: Doppelter Transfer verhindern
16.12.2018 21:01:56
Roger
Hallo Gerd
Danke für deine Ausführung. Funktioniert super.
Mit so einer Hilfe kann ich eher was anfangen als ("Nix für ungut, aber der Code ist Müll").
Es gibt sicherlich viele Code die noch besser geschrieben werden können. Aber jeder hat auch andere Sichtweisen und Bedürfnisse.
Nochmals, herzlichen Dank Gerd
AW: Doppelter Transfer verhindern
16.12.2018 21:15:55
Roger
Was mir jetzt noch aufgefallen ist, dass nach dem übertragen in die neue Tabelle die Daten vom Startfile untereinander angeordnet werden und noch waagerecht = Zeilenweise übertragen werden.
Muss ich da noch etwas abändern?
AW: Doppelter Transfer verhindern
16.12.2018 21:58:03
Gerd
Stimmt, deinen Offset habe ich nicht beachtet.
Sub uebertrag()
Dim arstrName(1 To 5) As String
Dim i As Long, zeile As Long, spalte As Long
With Worksheets("Maske")
arstrName(1) = .Range("K10")
arstrName(2) = .Range("K12")
arstrName(3) = .Range("K14")
arstrName(4) = .Range("K16")
arstrName(5) = .Range("K18")
End With
With Worksheets("Aufträge gesamt")
zeile = 5
If .Range("A5")  "" Then zeile = .Range("A4").End(xlDown).Row + 1
For i = 1 To 5
If WorksheetFunction.CountIf(.Range(.Cells(5, 2), .Cells(zeile, 6)), arstrName(i)) = 0  _
_
Then
spalte = spalte + 1
.Cells(zeile, spalte) = arstrName(i)
End If
Next
End With
Erase arstrName
End Sub

Anzeige
AW: Doppelter Transfer verhindern
17.12.2018 06:36:46
Roger
Guten Morgen Gerd
Ich habe noch die eine Korrektur gemacht (ein _ vor Then habe ich noch entfernt)und läuft jetzt perfekt.
Herzlichen Dank!
Schöne Festtage wünsche ich.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige