Office: Makro zum Kopieren (Komplex?!)

Hallo!

Ich brauche auch mal eure Hilfe. Ich versuche seit 2 Tagen folgendes mit einem Makro zu realisieren.

Und zwar habe ich 2 Tabellenblätter. Das eine Blatt enthält Werte, die sich allerings je nach "Auswahl 1" (Mit Gültigkeit eine Liste erstellt) und Auswahl 2 ändern. Betroffen sind die Zellen F31 und D43. Diese Zellen Möchte ich per Mausclick (Commandbutton) auf das zweite Tabellen blatt in die richtige Spalte und Zeile kopieren. Werte wr Auswahl 1 finde ich in dem Tabellenblatt 2 Zellen C2:AA2. Werte für Auswahl 2 sind in Tabellenblatt 2 Zelle A4:A36.

Jetzt habe ich bereits etwas versucht, was aber glaube ich ein bischen umständlich ist. Bei meiner Lösung müsste ich für jede Zelle (C4:AA36) eine If Abfrage erstellen. Wie lang das Makro wird kann sich jeder denken.

Das geht doch bestimmt auch einfacher mit einer Schleife und +1 oder so? Ich bin blutiger Anfänger in VBA.

Soweit habe ich es bisher versucht.

Code:

Sub Getdata()

'Ist für AAA / 1
If Worksheets("Tabellenblatt2").Range("C2") = Worksheets("Tabellenblatt1").Range("B3") Then
If Worksheets("Tabellenblatt2").Range("A4") = Worksheets("Tabellenblatt1").Range("B7") Then
With Worksheets("Tabellenblatt2").Range("D4")
  .Value = Worksheets("Tabellenblatt1").Range("D43")
  .Select
End With
With Worksheets("Tabellenblatt2").Range("C4")
  .Value = Worksheets("Tabellenblatt1").Range("F31")
  .Select
End With
End If
End If
'Ist für AAA / 2
If Worksheets("Tabellenblatt2").Range("C2") = Worksheets("Tabellenblatt1").Range("B3") Then
If Worksheets("Tabellenblatt2").Range("A4") = Worksheets("Tabellenblatt1").Range("B7") Then
With Worksheets("Tabellenblatt2").Range("D5")
  .Value = Worksheets("Tabellenblatt1").Range("D43")
  .Select
End With
With Worksheets("Tabellenblatt2").Range("C5")
  .Value = Worksheets("Tabellenblatt1").Range("F31")
  .Select
End With
End If
End If
End Sub

Bin für jede Hilfe Dankbar!

Grüße

 

Hallo, Thosch!

Soweit ich das verstehe, hast Du eine Matrix mit den Ausmaßen y von 4 bis 36 und x von 3 (C) bis 27 (AA). Diese komplett abzuarbeiten wäre dann Aufgabe zweier ineinander verschachtelter For-Next-Schleifen:

Code:

for y1 = 4 to 36
  for x1 = 3 to 27
    [...]
  next x1
next y1

Innerhalb der Schleife soll jetzt was genau passieren? wenn ich das richtig aus Deinem Source heraus verstanden habe:

Unter der Voraussetzung, daß tabellenblatt2!c2=tabellenblatt1!b3 und tabellenblatt2!a4=tabellenblatt1!b7 ist: Kopiere aus aus tabellenblatt1 die Zelle d43 und f31 in die Ziel-Matrix.

Die Ziel-Matrix beginnt in tabellenblatt2 bei Zeile 4 in den Spalten 3 (C) und 4 (D), Folgewerte werden zeilenweise darunter einkopiert.

Das würde bedeuten, daß man
a) vor den beiden Schleifen (s.o.) einen Zeiger auf die Zeile in der Zielmatrix braucht und
b) den Wert aus der Quell- in die Ziel-Matrix kopiert und
c) den Zeiger in jedem Durchlauf erhöht.

Das erweitert den o.a. Code schonmal auf:

Code:

y2=4
for y1 = 4 to 36
  for x1 = 3 to 27
    [...]
    y2=y2+1
  next x1
next y1

Und jetzt noch die Entscheidung, welcher Wert kopiert werden soll... Mit x1 und y1 werden die Koordinaten aus der Quell-Matrix besetzt, x2 und y2 sind die Koordinaten in die Ziel-Matrix.

Code:

dim s1 as worksheet
dim s2 as worksheet
dim y1 as long
dim x1 as long
dim y2 as long
dim x2 as long

set s1 = worksheets("tabellenblatt1")
set s2 = worksheets("tabellenblatt2")

y2=4
for y1 = 4 to 36
  for x1 = 3 to 27

    if s1.cells(2,3).value = s1.cells(3,2).value then
      if s2.cells(4,1).value = s1.cells(7,2).value then

        x1 = 4 : y1 = 43 'D43
        x2 = 4 'Dy
        s2.cells(y2,x2).value = s1.cells(y1,x1).value
        x1 = 6 : y1 = 31 'F31
        x2 = 3 'Cy
        s2.cells(y2,x2).value = s1.cells(y1,x1).value

      endif
    endif

    y2=y2+1

  next x1
next y1

Das dürfte Deinem Code entsprechen. Ich schätze aber mal, es ist nicht das, was Du haben wolltest. Ich sehe nicht wirklich die Abarbeitung der Quell-Matrix C4:AA36. Aber kannst ja erstmal schauen, was da noch geändert werden muß.

Gruß, Michael

 

Hallo!

Danke schonmal dafür.
Ich habe das Mal eingebaut. Leider füllt er jetzt alle Zellen in der Spalte C & D aus, sprich bis Zeile 65irgendwas.
Geplant hatte ich es eigentlich, dass er nur die Werte aus F31 und D43 (Tabellenblatt1) kopiert, wenn die Bedingungen (if s1.cells(2,3).value = s1.cells(3,2).value then if s2.cells(4,1).value = s1.cells(7,2).value then ) erfüllt sind. und diese in die jeweilige Zelle in Tabellenbaltt2 Spalte C&D einfügt.

Ja in die Ziel Matrix. aber nur in Zelle C4 (den Wert aus Tabellenbaltt1!F31) und Zelle D4 (den Wert aus Tabellenblatt!1D43), wenn auch die Bedingungen erfüllt sind. Sollte sich der Wert in Tabelleblatt1!B7 ändern, so sollte das Makro die Werte von Tabellenblatt1 in die richtige Zeile Tabellenblatt2 einfügen..

Noch eine Idee?

Im Prinzip braucht das Marko nur eine Zielzelle unter 2 Bedingungen aus einer Matrix suchen und zwei werte reinschreiben. Quasi: =INDEX mit VERGLEICH nur umgekehrt.. Klingt so einfach, ich weiß ;)

Grüße

 

Und was ist mit der 2. Hälfte Deines Sourcecodes? Dort wird in C5 / D5 kopiert. Und Du schriebst, daß Du das ja "für jede Zelle" machen würdest, also ging ich davon aus, daß es in C6 / D6 usw. weitergehen würde.

Und was ist "die jeweilige Zelle" denn dann?

Gruß, Michael

 

Hallo!

Ja es sollte auch in jeder Zelle weitergehen, aber die restlichen Zellen sollten erst ausgefüllt werden, wenn die Bedungungen erfüllt sind.
Z.B. Tabellenblatt1!B3=Tabellenblatt!C2 & Tabellenblatt1!B7=Tabellenblatt2!A11. (AAA=AAA&8=8) Dann sollten die Werte aus Tabellenblatt1!F31 und Tabellenblatt1!D43 nach Tabellenblatt2!C11 und Tabellenblatt2!D11 kopiert werden.

Grüße

 

So ich habe das ganze mal eingebaut und vorher ein bisschen verändert.

Im xls File habe ich mal die Zellen markiert, die nicht funktionieren.
Fllt weiss noch jemand etwas..

Grüße

 

Naja, schon, aber: Wenn die Bedingung 1x erfüllt ist, ist sie es immer und immer wieder.

Das war ja das, was mich von Anfang an wunderte: Du vergleichst konstant 2 Zellen mit 2 anderen. Während des Laufs können sich die Inhalte der 4 Zellen nicht ändern.

Also: Trifft der Vergleich am Anfang zu, werden alle Zellen kopiert, trifft der Vergleich am Anfang nicht zu, bleiben alle Zellen leer.

Und wo da jetzt der Bereich C4:AA36 auftaucht, blieb mir bislang auch verschlossen.

Gruß, Michael

 

Hi!

Für den Bereich habe ich schon eine andere Lösung. Hast du dir mal die Hilfe2.xls angeschaut?
Wenn ich im Tabellenblatt1 die Zelle B7 z.b. auf 15 habe und Zelle B3 auf AAA klappt es wunderbar, so wie ich mit wünsche. Ändere ich aber die Zelle B7 z.b. auf 28, so schreibt er mir die Zelle F31 und D43 von Tabellenblatt1 in die Zellen auf Tabellenblatt 2 eine Zeile zu hoch. Denn dort wäre ja "27" die Bedingung, oder?
Das passiert aber erst ab Tabellenblatt1!B7=26

Versteh ich aber net :)

Grüße

 

Ich glaube, so langsam dämmert mir, was Du da vorhast...

Aber das sieht eine ganze Ecke anders aus, als ursprünglich beschrieben. Das ist ja schon keine 2D-Tabelle mehr, sondern geht sogar schon in Richtung 3D, obendrein auch noch gespickt mit der Falle, daß die nicht "kontinuierlich" ist, sondern im rechten Teil auch noch von "Text"-Spalten unterbrochen ist.

Daß da ein Haufen verbundener Zellen mit im Spiel sind ist da ja schon fast Nebensache...

Also sehe ich das richtig:
Wenn auf Blatt 1 in Zelle B3 der Wert JJJ und in Zelle B7 der Wert 16 steht, dann sollen die Werte aus F31 und D43 auf Blatt 2 in die Zellen X19 bzw. Y19 kopiert werden?

Dann gestaltet sich das ganze ungleich schwieriger. In dem Fall muss herausgefunden werden
a) in welche Zeile der Ziel-Tabelle einkopiert werden soll. Dazu muß auf Blatt 2 in Spalte A ab Zeile 4 nach dem passenden Wert gesucht werden.
b) in welche Spalte(n) einkopiert werden soll. Dazu muß in Zeile 3 ab Spalte C gesucht werden.

Der erste Teil gestaltet sich relativ simpel, weil es numerische Werte sind, die lückenlos untereinander stehen. Die Ziel-Zeile hat man also mit
Wert aus B7 plus 3

Der zweite Teil ist etwas aufwendiger. Hier muß in einer Schleife nach dem passenden Wert gesucht werden.

Aber soll es das sein?

Gruß, Michael

 

Und wenn's das ist, dann versuch's mal in Modul1 mit:

Code:

Option Explicit

Public Sub Getdata()

    Dim s1 As Worksheet
    Dim s2 As Worksheet
    Dim y2 As Long
    Dim x2 As Long

    Set s1 = Worksheets("Tabellenblatt1")
    Set s2 = Worksheets("Tabellenblatt2")

    For y2 = 4 To 36
      For x2 = 3 To 27

        If s1.Range("B3").Value = s2.Cells(2, x2).Value Then
          If s1.Range("B7").Value = s2.Cells(y2, 1).Value Then

            s2.Cells(y2, x2).Value = s1.Range("F31").Value
            s2.Cells(y2, x2 + 1).Value = s1.Range("D43").Value

          End If
        End If

      Next x2
    Next y2

End Sub

Das ist zwar nur die "quick and dirty" Variante, aber besser als nix...

Gruß, Michael

 

Hiho!

Genau das wollte ich! Funktioniert einwandfrei! Danke!!!!

Grüße