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 akzeptieren 2. schließen Sie die Frage - Ihr Anruf..
  • Ich bevorzuge die he-Who-Must-not-Genannt-Werden, aber ich habe die Nummer 1. Danke!
InformationsquelleAutor Parseltongue | 2013-01-24
Schreibe einen Kommentar