Zeile durchsuchen und kopieren

  • Excel

Es gibt 11 Antworten in diesem Thema. Der letzte Beitrag () ist von petaod.

    Zeile durchsuchen und kopieren

    Hallo zusammen,

    ich bin neu hier und finde leider keine passende Lösung für mein Problem.

    Aufgabenstellung:

    ich habe 2 Tabbellenblätter, Datenbank und Imput.
    In Input werden Täglich neue Daten eingelesen.

    ich brauche einen Abgleich der beiden Blätter, sprich wenn in "Datenbank Spalte O" der Wert gleich ist zu"Imput Spalte O" soll er in "Datenbank Spalte Q" das aktuelle Datum und zeit eintragen, wenn dieser nicht vorhanden ist soll die gesamte Zeile aus Imput in die nächste Zeile von Datenbank Kopiert und in "Spalte P" das aktuelle Datum Zeit eingetragen werden.

    Leider sind meine VBA Kenntnisse nicht wirklich die besten daher wäre ich für eure Hilfe sehr dankbar.

    Gruß
    Michael

    Heyho, ich hab dir mal ein bisschen was gebastelt. du muss noch ein paar sachen abändern.
    Lese dir dann mal den code durch wenn du was genues nicht verstehst sag bescheid. Ich garantiere aber keine 100% das es kommplett fehlerfrei ist. Die anderen werden mich zwar virtuell "köpfen", da der code leicht unübersichtlich ist aber bei mir geht er :D
    "Klick mich"

    Visual Basic-Quellcode

    1. Dim db As String
    2. Dim inp As String
    3. Dim find As Boolean
    4. Dim round As String
    5. Dim round_true As Boolean
    6. Dim cout As Integer
    7. Private Sub cb_usernamesuche_Click()
    8. db = "Datenbank" 'hier den namen deines sheets rein
    9. inp = "Input" 'hier den namen des inputsheets rein
    10. round = ActiveSheet.Range("o2").Select
    11. find = False
    12. round_true = False
    13. Count = 2
    14. Do While (find = False And round_true = False)
    15. Dim w1 As String
    16. Dim w2 As String
    17. If rounde_true = flase Then
    18. Sheets(db).Select
    19. w1 = ActiveSheet.Range("o" & Count).Select
    20. Sheets(inp).Select
    21. w2 = ActiveSheet.Range("o" & Count).Select
    22. If w1 = w2 Then
    23. Sheets(db).Select
    24. ActiveSheet.Range("q" & round).Select = Date 'die Uhrzeit muss du noch dahainter fügen
    25. Else
    26. Sheets(inp).Select
    27. ActiveSheet.Range("a" & round & ":" & "q" & round).Select 'beim q die letzte spalte eintragen
    28. ActiveSheet.Copy
    29. Sheets(db).Select
    30. Dim leer As Boolean
    31. Dim c2 As Integer
    32. c2 = 2
    33. leer = False
    34. Do While (leer = False)
    35. If ActiveSheet.Range("a" & c2).Select = "" Then
    36. leer = True
    37. Else
    38. c2 = c2 + 1
    39. End If
    40. Loop
    41. ActiveSheet.Range("a" & c2).Select
    42. ActiveSheet.Paste
    43. ActiveSheet.Range("q" & c2).Select = Date 'die Uhrzeit muss du noch dahainter fügen
    44. End If
    45. round_true = True
    46. Else
    47. Sheets(db).Select
    48. w1 = ActiveSheet.Range("o" & Count).Select
    49. Sheets(inp).Select
    50. w2 = ActiveSheet.Range("o" & Count).Select
    51. If w1 = w2 Then
    52. Sheets(db).Select
    53. ActiveSheet.Range("q" & round).Select = Date 'die Uhrzeit muss du noch dahainter fügen
    54. Else
    55. Sheets(inp).Select
    56. ActiveSheet.Range("a" & round & ":" & "q" & round).Select 'beim q die letzte spalte eintragen
    57. ActiveSheet.Copy
    58. Sheets(db).Select
    59. Dim leer As Boolean
    60. Dim c2 As Integer
    61. c2 = 2
    62. leer = False
    63. Do While (leer = False)
    64. If ActiveSheet.Range("a" & c2).Select = "" Then
    65. leer = True
    66. Else
    67. c2 = c2 + 1
    68. End If
    69. Loop
    70. ActiveSheet.Range("a" & c2).Select
    71. ActiveSheet.Paste
    72. ActiveSheet.Range("q" & c2).Select = Date 'die Uhrzeit muss du noch dahainter fügen
    73. End If
    74. End If
    75. If ActiveSheet.Range("a" & Count).Select = "" Then
    76. find = True
    77. Loop
    78. End Sub



    VB Tags eingefügt
    - Solaris

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „Solaris“ ()

    Lord C schrieb:

    Die anderen werden mich zwar virtuell "köpfen"
    ...oder sich dezent zurückhalten. ;)

    Lord C schrieb:

    da der code leicht unübersichtlich ist
    und gegen viele Regeln einer sauberen Programmierung verstösst.

    Michael1985 schrieb:

    beim zweiten Dim leer Zeile 59
    "leer" ist in Zeile 30 schon definiert.
    Ziehe das Dim-Statement nach oben und verwende es nur einmal.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    Ach du meine Güte der Zeile 59 Fehler ist meiner. EInfach rauslöschen.

    @petaod das unsübersichtlich kommt von der Freude auf den Feierabend. :D Ich hatte den Code in glaueb ich 5-10 min zusammengeschrieben. Da ich helfen wollte.
    @Michael1985 Das ist eig. grad komisch. Und kein Problem dafür sind Foren da um zu helfen. Ich glaube petaod sollte nochmla drüberschauen. Ich finde den Fehelr nicht :D

    Visual Basic-Quellcode

    1. Set Db=Sheets("Datenbank")
    2. Set Inp=Sheets("Input")
    3. For r = 1 to Inp.Cells(Rows.Count,15).End(xlUp).Row
    4. v = Inp.Cells(r,15).Value
    5. Set c = Db.Range("O:O").Find(v, LookIn:=xlValues, LookAt:=xlWhole)
    6. If c Is Nothing Then
    7. Set c=Db.Cells(Rows.Count,15).End(xlUp).Offset(1)
    8. c.Value = v
    9. c.Offset(0,1).Value=Now
    10. Else
    11. c.Offset(0,2).Value = Now
    12. End If
    13. Next
    Ist jetzt mangels Excel nicht getestet, müsste aber passen.
    Falls du Fehler findest, darfst du sie gerne selbst berichtigen. ;)
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    Michael1985 schrieb:

    wenn du mir das noch sagen kannst biste mein Hero of de Day.
    Es ist nicht erstrebenswert, ein Held zu sein.
    Die meisten Helden sterben für den Ruhm derer, die den Nutzen aus der Heldentat ziehen.

    Der Code ist schon so weit vorgekaut, dass man mit minimaler Mühe selbst auf eine Lösung kommen könnte, wenn auch möglicherweise weniger elegant.

    Tausche Zeilen 7-8 gegen
    Inp.Range("A" & r & ":O" & r).Copy Db.Cells(Rows.Count,1).End(xlUp).Offset(1)
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --