VBA celinhoud "merged" cells wissen

[Dedeke]

Beste Super excellers

Ik heb een file waarin ik x aantal werkbladen heb die een identieke opmaak hebben. Dus enkel de naam is verschillend.
Elk blad heeft zo enkele verborgen kolommen, enkele samengevoegde cellen. In de verborgen kolommen staan alle cellen"geblokkeerd" (als dan ook het werkblad beveiligd is natuurlijk)
Wat ik nu wil bereiken is:
1. een manier om "automatisch"(command button of zo) de inhoud te wissen van alle (niet geblokkeerde)cellen en dit over de "x" aantal werkbladen
2. hetzelfde voor de "samengevoegde" cellen wat dus blijkbaar niet zo maar lukt. (zouden om "esthetische" redenen liever merged blijven) het oog wil ook wat
3. Een zekerheid dat uit mijn verborgen kolommen( waar de formules dus in zitten) onaangeroerd blijven

Vb: Werkblad 1: Range: A110 en dan een range G1(+H1+I1) wat dus eigenlijk de samengevoegde cel is van de 4 kolommen 1e cel. Kolom E en F staan "verborgen"
Werkblad2 : mag dus volledig hetzelfde zijn als werkblad 1 vermits de opbouw 100% gelijk is

Reeds zoiets geprobeerd:
For Each ws In ActiveWorkbook.Sheets
With ws
.Range("B2:B17") = ""
.Range("C2:E6") = ""
End With
Next ws
End Sub
Deze loopt vast van zodra er in de ranges ergens een samengevoegde cell zit

En deze:

Private Sub CommandButton1_Click()
Range("A2:B10").ClearContents
Range("E2:F10").ClearContents
End Sub

Deze loopt vast van zodra er in de ranges ergens een samengevoegde cell zit

Werk met office 2016, alle hulp is welkom.
File op zich is een beetje groot om hier te uploaden.

 

[VenA]

Dan maak je de file toch wat kleiner. Het hoeft echt niet het hele bestand te zijn. Samengevoegde cellen zijn normaal gesproken nergens voor nodig.

 

[Dedeke]

@Vena

Vena

Hier dan vlug een kopietje van 1 werkblad.

Ergens ben ik die bemerking van jou nog al tegen gekomen.

 

[VenA]

Misschien kan je even concreet zijn met wat je wil leegmaken uit deze mooie kleurplaat. De formules mag je ook wel even nalopen.

Waarom maak je van elk getal tekst?

=IF(E11="ja";"1";"0")

=n(e11="ja")

 

[popipipo]

zouden om "esthetische" redenen liever merged blijven

Kun je ook op ander manier bereiken nl. dmv cel opmaak

 

[Dedeke]

@Vena

Bedankt voor het compliment van het kleurboek.
1.Sorry dat ik niet zo een super excel gebruiker ben. Anders kwam ik hier niet ten rade.
2. Ja en nee word ook nog gebruikt om naderhand,ergens op een van de andere bladen, een snel overzicht te krijgen van ja of nee deelgenomen.
3. Concreet te wijzigen: Ik heb concreet de kleurenboek aangepast. Dat wat in "blauw" is gekleurd. Dus herhaaldelijk voor elk kleurenblok. Dit dus op 1 knopdruk op elk werkblad.
4.Betreft mijn formule: Ik ben heel leergierig dus alle wijzigingen die ten goede komen aan de werking hoor ik het graag.

Waarom maak je van elk getal tekst?? Heb ik op zitten dubben want begrijp niet wat je bedoeld.
In E11 laat ik gewon dus ja of nee invullen wat resulteert in een getal ergens anders. Dus hoe maak ik dan van elk getal tekst??
Ik wil best in mijn file dat wijzigen als het daardoor allemaal eenvoudiger kan.

"Samengevoegde cellen zijn normaal gesproken nergens voor nodig" was gewoon bedoeld dat ik dit nog al had gelezen en dat dit ook net toevallig een onderdeeltje is van de vraag. Dus dit was zeker niet kritisch bedoeld.
Dus ook hier wil ik graag bijleren hoe ik met voorwaardelijke opmaak hetzelfde "esthetische " effect kan bekomen zoals "Popipo" komt te vertellen.

 

[cow18]

Sub vegen()
   For Each sh In Sheets                         'alle bladen aflopen
      For Each c In sh.Cells.SpecialCells(xlConstants)   'alle cellen met vast inhoud aflopen (geen formules)
         If c.Address = c.MergeArea.Cells(1).Address Then   '1e cel igv. samengevoegde
            If Not c.Locked Then                 'niet geblokkeerd
               c.Value = ""                      'leegmaken
            End If
         End If
      Next
   Next
End Sub

 

[popipipo]

Dus ook hier wil ik graag bijleren hoe ik met voorwaardelijke opmaak hetzelfde "esthetische " effect kan bekomen

Ik bedoelde niet met 'voorwaardelijke opmaak' maar met het gewone 'celformaat'.

Kolom A tm P heb ik voor je aangepast

 

[Dedeke]

@Popipipo

Bedankt,

Dit is duidelijk als ik nu de opmaak ga bekijken. Heb hier uit geleerd.

@Vena: Uit deze opmaak heb ik nu ook geleerd dat je dus inderdaad GEEN samengevoegde cellen nodig hebt om iets mooi gecentreerd weer te geven over verschillende cellen.

@Cow18

Ga eerst mijn samengevoegde cellen eruit kieperen.
Vermoed dat jouw code dan ook weer dient aangepast te worden.
Volstaat het om het lijntje: If c.Address = c.MergeArea.Cells(1).Address Then '1e cel igv. samengevoegde er uit halen
of dient dan heel de code opnieuw aangepast te worden.

Ik kan het natuurlijk ook gewoon proberen

Sub vegen()
For Each sh In Sheets 'alle bladen aflopen
For Each c In sh.Cells.SpecialCells(xlConstants) 'alle cellen met vast inhoud aflopen (geen formules)
If c.Address = c.MergeArea.Cells(1).Address Then '1e cel igv. samengevoegde
If Not c.Locked Then 'niet geblokkeerd
c.Value = "" 'leegmaken
End If
End If
Next
Next
End Sub

 

[cow18]

er hoeft niets aangepast worden, die regel werkt voor gewone cellen + de 1e cel van samengevoegde cellen.
Maar als je toch geen samengevoegde cellen meer zou hebben, dan zou de ganse regel er anders uit kunnen + een corresponderende"End if"

PS. Kwa leesbaarheid, gebruik je, als je reageert, best die # in het menu erboven en daar gooi je de code tussen. Dat maakt het voor ons gemakkelijker.

 

[snb]

Sub M_snb()
   for each it in sheets
      it.cells.unmerge
   next
End Sub

 

[Dedeke]

@Popipipo

Misschien toch te vroeg viktorie gekraaid??? of ligt het aan eventueel een verschillende versie van excel.
Als ik het bestandje open waar jij de opmaak hebt op toegevoegd lijt in eerste instantie alles in orde. Echter niet alle headers staan constant ingevuld.
Met de headers bedoel ik dus de rij treffen en club.
Als ik nou uit het 2e blok Club en treffen weghaal versprintg alles uit het 1e blok gecentreerd over de 2 blokken samen.

Heb een print screen toegevoegd die het hopelijk duidelijk maakt.

 

[Dedeke]

@cow18

1.Ik heb nu geen "merged" cellen meer.
2. Code werkt
3. ik kom nu op volgende: Stel ik voeg nog werkbladen toe waar niets gewist dient te worden. Dan ga ik ervan uit dat ook daar alles gaat gewist worden dus

Vraag is nu of dit kan:

Command button die op:

blad 1 de inhoud wist van alle cellen in een bepaalde range behalve die waar een formule in staat.
Dan van blad 2 met eventueel een andere range.

Vb Blad 1 range A1:H40 in deze range alle inhoud wissen behalve de cellen waar een formule instaat.(vb B1:B40 en E1:E40)
vervolgens blad2 hetzelfde met eventueel een andere range.

Ik denk wel dat ik er dan in slaag om indien nodig een blad en range toe te kunnen voegen.

 

[cow18]

meerdere manieren

Sub vegen()
   For Each sh In Sheets                         'alle bladen aflopen
      Select Case sh.Name                        'opletten bij het spellen van de namen, dit is hoofdlettergevoelig !
         Case "Blad1", "Blad_2", "Blad 3": Set c0 = sh.Range("A2:D500")   'deze werkbladen hebben alle hetzelfde bereik
         Case "Ploeg1": Set c0 = sh.Range("D4:E200,G5:J100")   'bereik bestaat uit meerdere delen !
         '..... maak zo een opsomming van al je werbladen die behandeld moeten worden
         Case Else: Set c0 = Nothing             'de niet vermeldde werkbladen worden niet behandeld
      End Select

      If Not c0 Is Nothing Then 'is er voor dat tabblad een bereik bepaald ?
         For Each c In c0.SpecialCells(xlConstants)   'alle cellen met vast inhoud aflopen (geen formules)
            If Not c.Locked Then                 'niet geblokkeerd
               c.Value = ""                      'leegmaken
            End If
         Next
      End If
   Next
End Sub

PS. als je als 1e regel helemaal bovenin je module "Option Compare Text" schrijft (zonder die dubbele aanhalingstekens), dan zijn, in Select Case ... End Select, de namen niet meer hoofdlettergevoelig!

 

[snb]

@c0118

         Case Else: Set c0 = Nothing

is echt overbodig.

Gebruik bij specialcells de eigenschap areas

For Each it In c0.SpecialCells(2).areas
  it.clearontents
next

 

[cow18]

toch niet helemaal mee eens !
- Als er bepaalde bladen niet behandeld moeten worden, dan moet er een vlaggetje opgezet worden, zodat de daaropvolgende loop niet afgewerkt wordt, dat kon door een boolean ofwel lomp door c0 op nothing te zetten.
- een area maken van die specialcells, dat zou de boel inderdaad versnellen, maar, en dat weet enkel de vraagsteller, zijn alle cellen in al dergelijke areas unlocked ? The proof of the pudding is in the eating.

 

[snb]

Vlag is overbodig als je de tweede code binnen de case select methode plaatst.

een area maken van die specialcells,

Dat doet jouw code nu ook al automatisch; dat kun je nl. niet zelf.

 

[cow18]

zo dan, maar er wordt niet meer gecheckt op locked, zodat er eventueel een foutboodschap volgt

Sub vegen()
   On Error Resume Next                          'voor het geval er niets te vegen valt of iets anders fout gaat
   For Each sh In Sheets                         'alle bladen aflopen
      Err.Clear
      Select Case sh.Name                        'opletten bij het spellen van de namen, dit is hoofdlettergevoelig !
         Case "Ploeg1": sh.Range("D4:E200,G5:J100, N6, P5:R200").SpecialCells(2).ClearContents   'bereik bestaat uit meerdere delen !
         Case "Equipe1": sh.Range("D4:E200").SpecialCells(2).ClearContents
            '...
      End Select
      If Err.Number Then MsgBox "werkblad : " & sh.Name & vbLf & "Fout : " & Err.Number & vbLf & Err.Description
   Next
End Sub

 

[Dedeke]

@Cow 18

Ik heb momenteel je code in gebruik (die van gisteren 23Hr50) en dus aangepast met de namen en ranges zoals nodig.
Werkt perfect maar voordien moeten eerst alle werkbladen die vermeld staan "unprotected" worden.
Daarvoor heb ik nu een commandbutton gemaakt met volgende code. Doet gelukkig wat hij moet doen Toch al iets bijgeleerd.

Private Sub CommandButton2_Click()
'Unprotect Specific Multiple Worksheets:
     Sheets("12Nov (2)").Unprotect Password:="mypsw"
     Sheets("Dec (2)").Unprotect Password:="mypsw"
end sub

Vraag is of dit kan geïntegreerd worden in jouw code zodanig dus dat:
1. De werkbladen die leeggemaakt dienen te worden eerst "unlocked" worden. Paswoord is overal hetzelfde op de worksheets.
2. Kan er ook eerst een MsbBox verschijnen met een vraag en laten bevestigen met "ja" of "nee" (of cancel)

Verhoopt resultaat:
Gebruiker klikt op button
Krijgt de vraag vb: bent u zeker dat u alle inhoud wil wissen
klikt ja
Unlock de nodige werkbladen
Cellen worden gewist. Einde

Eventueel nieuwe MsgBox met bevestiging dat alles uitgevoerd is.(vb alle cellen gewist klik "ok" om te eindigen.)

Bij afsluiten van de file worden alle werkbladen automatisch terug "protected" (ben ik door hier veel tijd te spenderen en te lezen ook al in geslaagd)

De latere code met voorstellen van "snb" heb ik nog niet geprobeerd. Was al blij dat ik al het vorige aan de praat heb gekregen.

 

[cow18]

eerst even wat duidelijkheid verschaffen !
Een werkblad kan je beveiligen of niet (werkblad.protect/unprotect) en een cel kan je blokkeren of vergrendelen (cell.locked=true/false), begin dat liefst niet te mixen.

2 kleine wijzigingen, die vraagstelling en de beveiliging.
Eigenlijk kan je, in een beveiligd werkblad, een achterdeur openen met een userinterfaceonly-commando waardoor je toch zaken kan uitvoeren zonder dat lastige beveiliging eraf en terug op.
Dat moet eigenlijk maar 1 keer per sessie gebeuren, zoals je hieronder in het kadertje kan lezen.

Sub vegen()

[COLOR="#FF0000"]   If MsgBox("wil je echt wel " & vbLf & "- de inhoud van alle niet-vergrendelde cellen" & vbLf & "- in bepaalde tabbladen" & vbLf & " verwijderen ?", vbYesNo + vbCritical, UCase("              red alert !!!!!!!")) <> vbYes Then Exit Sub[/COLOR]

   For Each sh In Sheets                         'alle bladen aflopen
      Select Case sh.Name                        'opletten bij het spellen van de namen, dit is hoofdlettergevoelig !
         Case "Blad1", "Blad_2", "Blad 3": Set c0 = sh.Range("A2:D500")   'deze werkbladen hebben alle hetzelfde bereik
         Case "Ploeg1": Set c0 = sh.Range("D4:E200,G5:J100")   'bereik bestaat uit meerdere delen !
            '..... maak zo een opsomming van al je werbladen die behandeld moeten worden
         Case Else: Set c0 = Nothing             'de niet vermeldde werkbladen worden niet behandeld
      End Select

      If Not c0 Is Nothing Then                  'is er voor dat tabblad een bereik bepaald ?
 [COLOR="#FF0000"]        If sh.ProtectContents Then sh.Protect "mypsw",userinterfaceonly:=True   'is je werkblad beveiligd ? Via de achterdeur en met kennis van het paswoord toelaten dat macros hun werk toch kunnen blijven doen
 [/COLOR]        For Each c In c0.SpecialCells(xlConstants)   'alle cellen met vast inhoud aflopen (geen formules)
            If Not c.Locked Then                 'niet geblokkeerd
               c.Value = ""                      'leegmaken
            End If
         Next
      End If
   Next
End Sub