Wie kann man Überschneidungen von Bereichen aus einem Bereich ausschließen? (Makro für Zelleninhalt verschieben)

464
Piecevcake

Ich konnte kein Makro zum Verschieben von Zellinhalten finden, ohne die Formatierung zu ändern.

Ich habe unten ein Makro zusammengestellt, das dies erreicht, ABER es löscht den eingefügten Bereich, wo er den kopierten Bereich überlappt. Kann jemand mit dem Code helfen, den überlappenden Teil von der Löschung auszuschließen?

Wie kann man Überschneidungen von Bereichen aus einem Bereich ausschließen? (Makro für Zelleninhalt verschieben)

Sub E____MoveContentsOnlyKeepFormats_SIMPLE_Ctrl_M()  Application.CutCopyMode = False 'clears any existing copy mode On Error GoTo EXITSUB 'exits if cancel clicked (NB cant use label "end")  Dim RANGE_TO_COPY As Range 'define inputbox variable Dim CELL_TO_PASTE_TO As Range 'define inputbox variable  '-----------name SOURCE range = selected before macro started Set RANGE_TO_COPY = Selection 'is this necessary, when not using inputbox? COPYSOURCE = RANGE_TO_COPY.Address(False, False) 'name the inputbox selection as a range  '=========== inputbox to select PASTE destination Set CELL_TO_PASTE_TO = Application.InputBox("select cell/range to PASTE TO, with the mouse" & vbNewLine & "CANCEL IF RANGES OVERLAP!", Default:=Selection.Address, Type:=8)  '------------- assigns name to the selected DESTINATION range PASTERANGE = CELL_TO_PASTE_TO.Address(False, False) 'name the inputbox selection as a range  '=========== action = COPY SOURCE Range(COPYSOURCE).Copy  '======================PASTE TO DESTINATION 'DEFAULT: PASTE FORMULAS AND NUMBER FORMATS (MATCHES DESTINATION FORMAT, keeps date/ etc original):  Range(PASTERANGE) _ .PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'formulas+number format  '======DELETE SOURCE CELL CONTENTS - remove if COPY required  '??? how to select COPYSOURCE not overlapping PASTERANGE  Range(COPYSOURCE).ClearContents 'deletes contents keeps formatting  EXITSUB:  End Sub

Danke (ich bin ein Neuling, jede Hilfe geschätzt)

EDIT: Ich habe versucht, einen neuen Bereich aus dem COPYSOURCE-Bereich zu definieren, indem ich den Schnittpunkt mit den Argumenten Schnittpunkt oder Nichtschnittpunkt ausschließe. Ich konnte nicht herausfinden, wie.

0

1 Antwort auf die Frage

2
nutsch

Sie löschen Ihren gesamten ursprünglichen Bereich. Wenn es sich überlappt, werden auch überlappende Zellen gelöscht. Um dies zu vermeiden, überprüfen Sie jede Zelle, um zu sehen, ob es eine Überlappung, zB kann man ersetzen Range(COPYSOURCE).ClearContentsdurch

 Dim rgLoop As Range, rgToDelete As Range For Each rgLoop In Range(copysource).Cells If Intersect(rgLoop, Range(pasterange).Resize(Range(copysource).Rows.Count, Range(copysource).Columns.Count)) Is Nothing Then If rgToDelete Is Nothing Then Set rgToDelete = rgLoop Else Set rgToDelete = Union(rgToDelete, rgLoop) End If Next rgLoop  rgToDelete.ClearContents 'deletes contents keeps formatting
Dank dafür! Ich dachte, vielleicht gibt es eine Möglichkeit, einen neuen Bereich als COPYSOURCE minus mit PASTERANGE zu definieren? Ich habe ein paar Möglichkeiten ausprobiert, wenn nicht gekreuzt usw., konnte es aber nicht herausfinden. Ich weiß nicht, ob das schneller wäre? Piecevcake vor 6 Jahren 0
Wenn Ihre Dateien keine komplizierten Formeln enthalten, werden Sie keinen Unterschied feststellen nutsch vor 6 Jahren 0

Verwandte Probleme