• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

omruilen van inhooud

Status
Niet open voor verdere reacties.
L

longron

Gebruiker
Lid geworden
2 apr 2007
Berichten
365
Daar is ie weer...........

ik gebruik onderstaande routine om cellen om te wisselen.
nu blijkt dat ik het toch anders moet doen.


ik wil graag een aantal cellen gelijk omruilen.

Bv cellen ("A1:G1") ruilen met ("A6:G6")

deze formule gebruik ik:

Private Sub omwisselen(control As IRibbonControl)

Dim a As Variant
Dim aL As Variant
Dim msg As String
If Selection.Cells.Count = 2 Then
If Selection.Areas.Count = 1 Then
If (Selection.Cells(1).Formula = CStr(Selection.Cells(1)) Or _
IsNumeric(Selection.Cells(1).Formula)) And (Selection.Cells(2).Formula = _
CStr(Selection.Cells(2)) Or IsNumeric(Selection.Cells(2).Formula)) Then
a = Selection.Cells(1).Value
aL = Selection.Cells(1).NumberFormat
Selection.Cells(1) = Selection.Cells(2).Value
Selection.Cells(1).NumberFormat = Selection.Cells(2).NumberFormat
Selection.Cells(2) = a
Selection.Cells(2).NumberFormat = aL
Else
msg = "De selectie bevat formules. Er wordt niet gewisseld."
End If
Else
If (Selection.Areas(1).Formula = CStr(Selection.Areas(1)) Or _
IsNumeric(Selection.Areas(1).Formula)) And (Selection.Areas(2).Formula = _
CStr(Selection.Areas(2)) Or IsNumeric(Selection.Areas(2).Formula)) Then
a = Selection.Areas(1).Value
aL = Selection.Areas(1).NumberFormat
Selection.Areas(1) = Selection.Areas(2).Value
Selection.Areas(1).NumberFormat = Selection.Areas(2).NumberFormat
Selection.Areas(2) = a
Selection.Areas(2).NumberFormat = aL
Else
msg = "De selectie bevat formules. Er wordt niet gewisseld."
End If
End If
Else
msg = "Het aantal geselecteerde cellen en/of gebieden is ongelijk aan twee."
End If
If Len(msg) > 0 Then
MsgBox msg, vbInformation, "Namen zijn omgewisseld"
End If
End Sub

Dank voor reactie,

fijne avond
Ronald
 
Top Philiep..............
je hebt helemaal gelijk
Ook nog een zinnigere bijdrage?

groet,

Ronald
 
Blijkbaar niet goed gelezen, je code staat nog altijd niet tussen Code tags (Met het # teken):evil:
Je code is zo niet te lezen. Zet je code tussen code tags en gebruik inspringingen als je wilt dat er iemand je code gaat bekijken.
Is dit zinnig genoeg?
 
Bv cellen ("A1:G1") ruilen met ("A6:G6")

da's toch niet nodig, het zijn allebeide lege range's in uw voorbeeld.
 
Helemaal gelijk emields. Daarom staat er ook bij bv. En in mijn eerste bericht stond alleen een voorbeeld van de r outine en een voorbeeld van dat er een rijtje cellen moeten worden geruild.
En waar die cellen dan staan maakt niet uit.
als je de routine in het bestand leest dan zie je dat je moet klikken op twee cellen met Ctrl ingedrukt. dan draai je de macro en wisselt hij om.

nu wil ik allen dat hij een select ruilt van meerdere cellen tegelijk.
 
Dat gaat de goede richting op.
ik zal wel de cellen moeten aanpassen maar dat moet wel weer lukken.

het betreft een database van een roosterprogramma en ik wil de mogelijkheid hebben om werknemers op een andere positie op het rooster te zetten.
dus iedere keer zijn de geselecteerde cellen andere.
Maar denk dat ik hiermee weer verder kom.

Thanks.

Fijne avond.
 
Waarom kopieer je de 1e area niet ergens buiten je werkgebied, bv. 250 kolommen naar rechts of 1000 rijen naar beneden, daarna kopieer je areas(2) naar 1 en dan die dummyarea naar 2.
Natuurlijk naast je huidige checks kijken of het aantal rijen en kolommen voor beide areas gelijk zijn.
 
Jouw code in de OP is nog steeds onleesbaar. Net als de code in het bestand.
 
Laatst bewerkt:
Code: 
Sub omwisselen2()
    If Selection.Areas.Count <> 2 Then MsgBox "geen 2 afzonderlijk geselecteerde gebieden": Exit Sub
    Set c1 = Selection.Areas(1)
    Set c2 = Selection.Areas(2)
    If c1.Rows.Count <> c2.Rows.Count Or c1.Columns.Count <> c2.Columns.Count Or c1.Cells.Count <> c2.Cells.Count Then MsgBox "grootte van de 2 selecties klopt niet": Exit Sub
    c1.Copy Range("AA1")
    c2.Copy c1
    Range("AA1").Resize(c1.Rows.Count, c1.Columns.Count).Copy c2
End Sub
Verder moet je maar kijken of je nog had moeten checken voor formules of zo
 
Code: 
Sub M_snb()
   If Selection.Areas.Count = 2 Then
     sn = Selection.Areas(1)
     sp = Selection.Areas(2)
     Selection.Areas(1) = sp
     Selection.Areas(2) = sn
   End If
End Sub
 
@snb, akkoord als je enkel de waarden moest meenemen, maar ik dacht ook dat je opmaak moest overnemen.
Eigenlijk kon je nog 2 regels korter en met 1 array werken:d
 
Ik was bang dat je het dan niet meer kon volgen....:p
 
En dan heb je even gene tijd om te kijken en staat er weer wat moois.

echter.. Het gaat inderdaad alleen om de inhoud en niet om de Opmaak.
De controle dat er formules inzitten is niet echt nodig. ik bepaal eerder waar wel en niet gewisseld mag worden.
Wat ik er wel graag in wil bakken is het volgende:

De selectie die gewisseld moet worden is bv A1:G1 met A9:G9.
Ik wil dit doen door de cellen A1 en vervolgens A9 aan te klikken.
De selectie moet dan automatisch gedaan worden.

de wissels moeten steeds wel in dezelfde kolom plaats vinden maar de rijen zijn steeds variabel.

Hoop dat het duidelijker wordt

Alvast dank voor het meedenken en goed weekend toegewenst.

Ronald
 
Code: 
Sub VenA()
  r1 = Application.InputBox("Selecteer eerste cel", , , , , , , 8).Address
  r2 = Application.InputBox("Selecteer tweede cel", , , , , , , 8).Address
  ar1 = Range(r1).CurrentRegion
  ar2 = Range(r2).CurrentRegion
  Range(r1).CurrentRegion = ar2
  Range(r2).CurrentRegion = ar1
End Sub
 
Thanks VenA

:( als ik deze routine gebruik gebeurd er niets.
Eigenlijk wil ik ook niet met een inputbox werken maar slechts met aan klikken. het aantal regels wat steeds moet worden gewisseld is hetzelfde.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan