Excel: Bewegt die Auswahl zum nächsten leeren Zeile in bestimmte Spalte und aufzählen Auswahl nach Datum und Typ
Neuen VBA, so sanft sein.
Ich habe 7 Spalten, A:H. Die erste Spalte ist eine eindeutige numerische Kennung (beginnt bei 0 und sollte erhöht werden jedes mal, wenn ich, fügen Sie eine neue Auswahl über das makro). Die zweite Spalte ist das Datum was eingegeben wird von hand, nachdem Sie dazu aufgefordert werden.
Ich möchte in der Lage sein, um markieren Sie einen Bereich von Zellen, aktivieren das makro, und das makro verschieben der Daten hervorgehoben und fügen Sie ihn in den nächsten freien chunk der Raum zwischen den C-und I-Spalten. Am Anfang, das makro fordert Sie ein Dialogfeld fragt den Benutzer nach dem Datum. Ich möchte dieses Datum eingetragen werden, an jedem Punkt entlang der B-Spalte (in der nächsten leeren Zelle) für jede Zelle in der Auswahl.
Hier sind, wie die Spalten formatiert sind, jetzt: http://i.imgur.com/7ytAnr9.png
Dann für jede Zelle in der Auswahl, ich will, dass es im Zusammenhang mit einer numerischen ID. Damit das Skript Aussehen würde, um zu sehen, was die Letzte Zahl in Spalte A hinzufügen, und fügen Sie, dass für jede Zelle in der aktuellen Auswahl.
Hier ist mein code, aber ich bin neu hier, es ist völlig gebrochen.
Für die DialogBox:
Sub SuperMacro()
Dim c As Object
Dim dateManager As String
dateManager = InputBox(Prompt:="Enter the Date for Selection", _
Title:="Date Manager", Default:="1/24/2013")
If strName = "Your Name here" Or _
strName = vbNullString Then
Exit Sub
End If
For Each c In Selection
Range("A1").End(xlDown).Offset(1, 0).Select 'Paste the date for each cell in selection
ActiveSheet.Paste
Next c
'Attempt to move all date from selected area to next available chunk of space between C1 and H1.
Selection.Copy
Range("C1:H1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
End Sub
EDIT: Herausgefunden, eine Lösung für die ID enumeration Problem und Spalte Bewegung:
Sub CopyTest()
Dim a As Range, b As Range
Dim value As Integer
Selection.Copy
Set a = Selection
Range("B1:H1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
value = (Range("A1").End(xlDown)) + 1
For Each b In a.Rows
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveCell.value = value
Next
End Sub
Lassen Sie mich wissen, wenn es ist ein effizienter Weg, dies zu tun.
Lösung gefunden, mich selbst, für die anderen:
Sub SuperMacro()
Dim a As Range, b As Range
Dim currentID As Integer
Set a = Selection
Selection.Cut Range("C1:I1").End(xlDown).Offset(1, 0) 'Pastes to appropriate column
currentID = Range("A1").End(xlDown).Value
For Each b In a.Rows
Range("A1").End(xlDown).Offset(1, 0) = currentID + 1
Range("B1").End(xlDown).Offset(1, 0) = InputBox("Enter Date", "Date Helper")
Next b
End Sub
- Wenn Sie die Lösung gefunden, die auf Ihre eigenen - Sie können die Antwort akzeptieren, wird effizienter.
- Parseltongue aka TomRiddle... Sie haben zwei Möglichkeiten..
1.
Antwort und akzeptieren2.
schließen Sie die Frage - Ihr Anruf.. - Ich bevorzuge die he-Who-Must-not-Genannt-Werden, aber ich habe die Nummer 1. Danke!
Du musst angemeldet sein, um einen Kommentar abzugeben.
Hier ist die Antwort, die ich gefunden habe: