Makro zum Nachschlagen des Datums im Spaltenbereich, Einfügen von Zeilen und Einfügen von Daten

1415
Lauren

Ich möchte ein Makro haben, das:

  1. Ermitteln Sie auf Seite ("Original") den Wert einer Zelle ($ E8, ein Datum)
  2. Gehen Sie zu einer anderen Seite ("Übertragen"), (Seitenname variiert, der entsprechende Seitenname wird jedoch in "Original" $ Z $ 1 angezeigt.)
  3. Schauen Sie sich die A-Spalte von "Transfer" an, die jeden Montag auflistet (Datumsbereich beginnt bei A20, Text oben).
  4. Finden Sie den Montag vor diesem $ E8-Datum (also für $ E8 = Sa 17. Würde es Mo 12 sein.)
  5. Fügen Sie eine Zeile ein. BENEATH diese Montagzeile (also vor der Zeile, die Mo 19. sagt)
  6. Löschen Sie diese Zeile (Mo-12 geht die Zeile leer, Mo-19
  7. Ausschneiden / Kopieren von ("Original $ E8") aus dem Bereich A8: H8
  8. Gehen Sie zur Seite "Übertragen"
  9. Fügen Sie diese A8: H8-Auswahl in die bei 5 erstellte Zeile ein.
  10. Kehren Sie zurück und machen Sie dasselbe für $ E9, bis alle Informationen in "Transfer" eingefügt wurden.

Die Zellen, die ich angegeben habe, sind die richtigen Zellen, die Daten, die ich gerade erstellt habe (sie variieren ohnehin für jedes Konto).

Eric hat mir freundlicherweise einen Code zur Verfügung gestellt, den ich geändert habe.

 Public Sub do_stuff() Dim date_to_look_for As String Dim row As Integer  date_to_look_for = Range("'Original'!K8").Value '^L: This is the cell that you are reading from. Ensure it is the MONDAY formula row = 20 '^L: This is where the Transfer date values start  Do Until row = Range("'Transfer'!A1").End(xlDown).row + 1 'create our loop. 'Notice that the .end function will find the end of the data in a column  If Range("'Transfer'!A" & row).Value = date_to_look_for Then '^L: Look for Original (X) Value specified above (make sure it's Monday).  Range("'Transfer'!" & row + 1 & ":" & row + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove '^L: Once  Range("'Transfer'!A" & row + 1 & ":H" & row + 1).Value = Range("'Original'!A8:H8").Value  '^L:This is WHERE it will paste '^L: This is what will copy Exit Sub 'no sense in running loop more if already found End If row = row + 1 Loop  'If code gets here then the date was never found! so tack to end of list Dim endrow As Integer endrow = Range("'Transfer'!A1").End(xlDown).row  Range("'Transfer'!A" & endrow & ":H" & endrow).Value =  Range("'Original'!A8:H8").Value '^L: What is this?  End Sub

(Die L: -Nachrichten sind meine Notizen, als ich herausgearbeitet habe, was jeder Abschnitt getan hat - bitte korrigieren Sie mich, wenn ich es falsch verstanden habe. Die anderen grünen Notizen sind die von Eric und ich bin mir nicht sicher, ob ich diese Teile verstehe. Das muss aber wirklich nicht sein, solange es funktioniert, aber wenn Sie mich über das Programmieren informieren möchten, können Sie sich bitte frei fühlen: D)

Mein Problem ist jetzt, wie man es schleifen lässt, damit es die ursprünglichen Werte herunterläuft (in diesem Fall die K-Spalte, also geht es zu K9, K10 usw.) und macht dasselbe? Kann es auch schneiden anstatt COPY und einmal vom Originalbogen entfernen?

Danke an alle, die geholfen haben, ihr seid großartig!

1
Ich verstehe nicht, warum ich überhaupt keine Hilfe bekomme, um ehrlich zu sein. Könnte auch versuchen, ein breiteres Netz zu werfen, um Hilfe zu erhalten. Ich kann nicht codieren und ich habe Tage damit verbracht - ich kann es einfach nicht schaffen, dass es funktioniert. Lauren vor 6 Jahren 0
Und ich habe zwei vorhandene Codes veröffentlicht. Sie sagten, weder würde funktionieren, ohne zu erklären, warum. Auch wenn man es gelegentlich tut - ich hatte gehofft, ich könnte das ändern. Und als ich den Fehler zeigte, der den Absturz verursacht hat, haben Sie nicht geholfen. Wenn Sie nicht helfen können oder wollen, ist das in Ordnung. Aber vielleicht jemand anderes. Lauren vor 6 Jahren 0
Sie haben hier geantwortet, aber nicht dort. Ich konnte nur annehmen, dass Sie entweder nicht helfen wollten oder konnten. Wenn ich versuche, das Makro meiner Kollegen auszuführen, stürzt es ab, wenn Folgendes angezeigt wird: "Wenn nichts gefunden wird, dann nichts". Excel friert ein und wenn ich nicht ESC raus habe, stürzt es ab. "@ScottCraner Lauren vor 6 Jahren 0
Lauren, könntest du einen Screenshot der Arbeitsblätter "Original" und "Transfer" erstellen? Sie können die Daten stornieren, ich möchte nur die Blattstruktur sehen. Ich kann dir helfen. Nate vor 6 Jahren 0
Ich habe gerade Ihren alten Code und das, was Sie hier gepostet haben, durchgegangen. Nur einige allgemeine Hinweise, die Ihnen helfen können, Ihr Problem herauszufinden. Zunächst ist Range ("'Sheet1'! A2"). Eine gute Möglichkeit, Zellwerte zu referenzieren, anstatt alle anderen Aufgaben des Makrorecorders auswählen und ausführen zu müssen. Wenn Sie "Wechseln" oder "Übertragen", können die meisten in einem ähnlichen Format wie Range ("'Sheet2'! A2"). Value = Range ("'Sheet1'! A2"). Value ausgeführt werden. Da es sich bei Ihrem Post meist um das Kopieren und Einfügen handelt, sollten Sie mit dieser Methode den Großteil Ihrer Aktivitäten aufklären. Ersetzen Sie einfach die Blattnamen, -spalten und -zeilen Eric F vor 6 Jahren 0
Danke Eric, das ist gut zu wissen! Ich werde ein bisschen herumspielen und sehen, ob das funktioniert. Momentan funktioniert der Code nicht, aber wünscht mir viel Glück :) Lauren vor 6 Jahren 0
@ ScottCraner Du hast recht. Es tut mir Leid. music2myear vor 6 Jahren 0
Worüber redest du? Ich habe vor zwei Tagen gepostet, und die Antwort, die ich erhielt, hat nicht funktioniert, also habe ich versucht, meine Antwort klarer darzustellen und erneut zu veröffentlichen. Ich habe hier gepostet und gehofft, dass noch mehr Leute helfen könnten. Ich gab die Codes und die Bilder auf Anfrage. Sie sagten, dass sie nicht arbeiten würden, aber nicht weiter ausgeführt wurden. Lauren vor 6 Jahren 0

2 Antworten auf die Frage

1
Nate

Dies sollte tun, was Sie suchen. Ich habe den Code kommentiert, damit Sie genau lesen können, was passiert. Beachten Sie, dass dieser Code die Range-Typvariable verwendet. Dies bedeutet, dass die Variablen rTransfer und rOriginal auf tatsächliche Zellen im Arbeitsblatt verweisen.

Hoffe das hilft! Viel Glück!

Sub TransferMyData() 'Declare the variables to be used in the code Dim wsTransfer As Worksheet, wsOriginal As Worksheet Dim rTransfer As Range, rOriginal As Range, rCopyRange As Range Dim dMonday As Variant Dim iRow As Integer  'Set the worksheet variable, this makes is easier than constantly referencing each sheet in the code all the time Set wsTransfer = ThisWorkbook.Worksheets("Transfer") Set wsOriginal = ThisWorkbook.Worksheets("Original")  'Set rOriginal to reference range E8, the first cell we are checking for a date to transfer Set rOriginal = wsOriginal.Range("E8")  'Run this loop over and over until the cell referenced in rOriginal is blank. 'At the bottom of the loop we shift rOriginal down by one Do While rOriginal <> "" 'Find the Monday of the week for rOriginal dMonday = rOriginal - Weekday(rOriginal, 3)  'Format dMonay to match the Transfer worksheet - Commented out 'dMonday = Format(dMonday, "dd-mm-yy")  'Set the cell of rTransfer using the Find function (Search range A:A in wsTransfer for the monday we figured out above) Set rTransfer = wsTransfer.Range("A:A").Find(dMonday)  'Error check. If rTransfer returns nothing then no match was found If rTransfer Is Nothing Then MsgBox ("Can't find the Monday for ") & rOriginal & ". Searching for Value " & dMonday Exit Sub End If  'Check if there was already some data transfered in for that week (rTransfer.Offset(1,4) references the 'E' column of the row below). 'If there is a value there, shift down by one and check again Do Until rTransfer.Offset(1, 4) = "" Set rTransfer = rTransfer.Offset(1, 0) Loop  'Insert a blank row below rTransfer using the offset function rTransfer.Offset(1, 0).EntireRow.Insert  'Set iRow to be the row number of rOriginal to be used below iRow = rOriginal.Row  'Set the range rCopyRange to be the range A:H of the row for iRow (See https://www.mrexcel.com/forum/excel-questions/48711-range-r1c1-format-visual-basic-applications.html for explanation) Set rCopyRange = wsOriginal.Range(Cells(iRow, 1).Address, Cells(iRow, 8).Address)  'Copy the range rCopyRange into the blank row we added rCopyRange.Copy rTransfer.Offset(1, 0)  'Offset our rOriginal cell down by one and restart the loop Set rOriginal = rOriginal.Offset(1, 0)  'Clear out the copied range. Can replace with rCopyRange.Delete if you want to delete the cells and have everything shift up rCopyRange.Clear  'Simple error check, if for some reasone you're stuck in an endless loop this will break out If rOriginal.Row > 999 Then MsgBox "Error! Stuck in Loop!" Exit Sub End If Loop  End Sub
Es sieht wirklich gut aus, danke Nate, aber es kommt kein Wert heraus. Ich erhalte die Fehlermeldung "den Montag für den 22.11.16 nicht finden". Der Original-E8-Wert, der 22/11/16, war ein Dienstag, also hätte er sich zwischen die Transfer-A-Reihe setzen müssen, um den 21. und den 28. zu sagen. Irgendwelche Gedanken? Lauren vor 6 Jahren 0
Es ist die Formatierung für den Wert dMonday. Setzen Sie die Format () - Funktion in Google und fügen Sie vor dem Suchen eine Zeile dMonday = Format (dMonday, "Your Format Here") hinzu. Versuch das und lass es mich wissen, ich werde für die nächste Zeit beschäftigt sein. Nate vor 6 Jahren 0
Ich habe den Code oben geändert, damit der Fehler Ihnen genau anzeigt, wonach er sucht. Dies hilft Ihnen herauszufinden, warum es keine Übereinstimmung findet. `MsgBox (" Den Montag kann ich nicht finden ") & rOriginal &". Suche nach Wert "& dMonday` Nate vor 6 Jahren 0
Dort habe ich auch die Zeile hinzugefügt, um die Formatierung zu korrigieren. Ich bin mir ziemlich sicher, dass dies den Trick schaffen wird. Nate vor 6 Jahren 0
Danke, Nate, Eric scheint irgendwie zu funktionieren, aber ich muss noch ein paar Dinge korrigieren. Ich werde das OP ändern, wenn es Ihnen nichts ausmacht, einen Blick darauf zu werfen? Vielen Dank übrigens! Lauren vor 6 Jahren 0
Aber bitte nicht dein oder irgendetwas löschen: D Lauren vor 6 Jahren 0
Sicher, kein bisschen genommen! Du solltest es einmal versuchen, nur um zu sehen;) Nate vor 6 Jahren 0
Ich werde es auf jeden Fall tun, es ist nur 5 Uhr morgens und ich bin seit über 36 Stunden hier. Ich bin nicht einmal sicher, ob das keine Halluzination ist, und ich wache auf, wenn das Makro immer noch abstürzt und anfängt zu weinen: D. Lauren vor 6 Jahren 0
https://xkcd.com/1319/ Ich bin mir ziemlich sicher, dass diese Grafik fasst, was Sie gerade tun. Prost! Nate vor 6 Jahren 0
XD Das ist absolut genau! Ich habe Ihren Code ausprobiert und ein wenig mit der Kalkulationstabelle rumgespielt, und ich habe es auf die gleiche Stufe gebracht, in der sich Eric gerade befindet. Aber bei Ihnen muss ich die Datumsangaben manuell in Transfer eingeben und Ihr "dMonday = Format (dMonday," dd-mm-yy ")" löschen, damit es funktioniert. Es funktioniert, wenn ich die Datumszellen in A nach unten klicke, aber nicht, wenn irgendeine Formel vorhanden ist - Text sein muss. Was ist gut, ich kann damit leben, aber jeder Workaround vom Kopf weg? Wie kann ich auch festlegen, dass die Daten nach der Übertragung gelöscht werden? Lauren vor 6 Jahren 0
Hoffentlich durchläuft es Ihre Liste ganz nach unten und kopiert die Werte in? Ich habe den Code bearbeitet, um unten eine Zeile `rCopyRange.Clear` hinzuzufügen. Dadurch werden die Zellen im Originalblatt gelöscht, nachdem sie Zeile für Zeile kopiert wurden. Sie können es auch in `rCopyRange.Delete` ändern und die gesamten Zellen löschen, wodurch alles nach oben verschoben wird. Wählen Sie aus, welche für Sie am besten geeignet ist. Und ich habe einen Fehler behoben, durch den die neue Reihe eingefügt wurde. Ich änderte es in `rTransfer.Offset (1, 0) .EntireRow.Insert` und fügte das EntireRow-Bit hinzu, oder es wurden nur Zellen eingefügt, keine ganz neue Zeile. Nate vor 6 Jahren 0
Was das Datum angeht, bin ich zu 95% sicher, dass es eine Formatierungssache ist. Ich müsste mir die eigentliche Arbeitsmappe ansehen, um es herauszufinden. Nate vor 6 Jahren 0
Hallo Nate, danke dafür. Ich habe es selbst so modifiziert, dass es funktioniert, aber ich werde ein Auge auf diese Änderungen haben, wenn ich mich darauf vorbereite, das richtige Blatt zu verwenden (momentan mit einem Dummy). Ich habe auf MrExcel mit meinen Ausgaben gepostet, wenn Sie lieber dorthin gehen würden, wo die Diskussionen besser sind ("Makrokonflikt beim Einfügen von Spalten und Datum".) Ich habe immer noch ein Problem mit der Suche nach A: Ein Datum, das nicht eingegeben wird oder nach unten gezogen (das eigentliche Blatt verwendet eine Formel und funktioniert auch nicht, wenn ich dd-mm-yy formatiere). Auch wenn das Datum in E ein Montag ist, wurde der entsprechende Montag A: A über dem entsprechenden Montag eingefügt, nicht darunter, also unter der falschen Woche. Lauren vor 6 Jahren 0
Ich habe eine Umgehung für die "falsche Linie" gemacht, wo ich die ursprüngliche Spalte A "= [E: E + .01]" mache, dann die Spalte A: A filtern, so dass das ursprüngliche Datum gleich erscheint, aber gelesen wird es ist um 0,1 größer. Es funktioniert, aber es ist nicht ideal, also wäre jede Idee, die Sie haben, besser: D. Lauren vor 6 Jahren 0
0
Eric F

Hier ist ein Beispiel, von dem ich glaube, dass es erfasst, was Sie im Allgemeinen versuchen. Ich habe in meiner Arbeitsmappe zwei Registerkarten mit der Bezeichnung "Transfer" und "Original" eingerichtet. Ich habe mein Original-Tab so eingerichtet, dass es wie folgt aussieht:

enter image description here

Die Daten in A, B, C, D spielen keine Rolle. Ich habe Spalte F und G, um zu bestimmen, welches Datum der "letzte Montag" ist. Dies kann natürlich in einer Zelle erfolgen, aber ich habe es auseinander genommen, damit Sie es besser verstehen können. In diesem Beispiel hat meine Zelle F2 = WEEKDAY (A2) -2, da die Funktion WEEKDAY den Wochentag als Zahl zurückgibt. Ich habe G2 als = A2-F2 gesetzt, um tatsächlich das "Datum vom letzten Montag" anzuzeigen.

Mein Transferblatt sieht so aus:

enter image description here

Von hier aus müssen wir also das Makro nachsehen, welche Zeile das letzte Montagdatum auf der Registerkarte "Übertragen" ist. Wir müssen auch sicherstellen, dass es existiert. Wenn es in meinem Beispiel nicht existiert, gehe ich einfach nach unten ...

Folgendes habe ich mit vielen Kommentaren für mein Beispiel geschrieben:

Public Sub do_stuff() Dim date_to_look_for As String Dim row As Integer  date_to_look_for = Range("'Original'!G2").Value row = 2 'whichever row is your start row for the data on the Transfer tab  Do Until row = Range("'Transfer'!A1").End(xlDown).row + 1 'create our loop. 'Notice that the .end function will find the end of the data in a column  If Range("'Transfer'!A" & row).Value = date_to_look_for Then 'row found for Monday! Do our magic here!  'insert a blank spot at the row found + 1 Range("'Transfer'!" & row + 1 & ":" & row + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 'now copy data here Range("'Transfer'!A" & row + 1 & ":E" & row + 1).Value = Range("'Original'!A2:E2").Value Exit Sub 'no sense in running loop more if already found End If row = row + 1 Loop  'If code gets here then the date was never found! so tack to end of list Dim endrow As Integer endrow = Range("'Transfer'!A1").End(xlDown).row  Range("'Transfer'!A" & endrow & ":E" & endrow).Value =  Range("'Original'!A2:E2").Value  End Sub

Beachten Sie, wie ich mit der Funktion Range (). Value gleichzeitig Daten kopieren kann, und auch, wie ich einen Bereich angeben kann.

Nachdem Sie das oben gezeigte Makro ausgeführt haben, sollte dies auf der Registerkarte "Übertragung" angezeigt werden:

enter image description here

Kommentare sind nicht für eine erweiterte Diskussion vorgesehen. Diese Konversation wurde in den Chat verschoben (http://chat.stackexchange.com/rooms/60610/discussion-on-answer-by-eric-f-macro-to-look-up-date-in-column- Range-Insert-Zeile). DavidPostill vor 6 Jahren 0

Verwandte Probleme