Excel VBA. Conversie kolom cellen Boolean waarde naar Binaire waarde

[KPTPTT]

Hallo,
Ik heb een Excel sheet met één kolom en 20 rijen (B6-B26) waarin in ieder cel een Boolean waarde (waar/onwaar) staat aangegeven. Door middel van een druk op de knop in de sheet en VBA programmering (al met andere zaken geprogrammeerd) wil ik de Boolean waarde van alle 20 cellen converteren naar de binaire waarde "1" (geen -1) of "0". Ik heb veel gepuzzeld maar hopelijk kan iemand mij helpen met wat VBA code, alvast dank.

 

[SjonR]

zo?

Sub SjonR()
For Each cl In Range("B6:B26")
    If cl Then cl.Value = 1 Else cl.Value = 0
Next
End Sub

 

[KPTPTT]

Dank voor je hulp. Ik krijg wel een foutmelding "Typen komen niet overeen". If cl Then . Ik heb nog een Dim cl toegevoegd. Er staat: "If cl Then", hoe wordt hiermee de Boolean waarde bepaald?

 

[SjonR]

if cl then is standaard check of het een true is.

anders maar even een voorbeeldbestandje plaatsen waarin het niet werkt.

 

[edmoor]

Wat je zegt is helemaal waar SjonR maar ik zou 'm zo doen:

Sub SjonR()
    For Each cl In Range("B6:B26")
        cl.Value = IIf(cl, 1, 0)
    Next
End Sub

Voor de werking moet het verder niet uit maken.

 

[VenA]

Waar komen de WAAR en ONWAAR vandaan? Uit een formule? Als de typen niet overeenkomen dan staat er tekst in de cellen en geen Boolean. Plaats dus een representatief voorbeeld bestand.

 

[KPTPTT]

Dank voor de (snelle) hulp. De formule van Edmoor werkt goed maar de formule is te "enthousiast". Ik laat een gehele kolom met waarden met de formule converteren echter worden in de kolom ook waarden die decimale waarden vertegenwoordigen ook in een binaire 1 geconverteerd en dat is niet de bedoeling. In de kolom staan door elkaar decimale waarden en Boolean waarden respectievelijk afkomstig van een export vanuit Access van decimale invulvelden en vakjes met vinkjes (Boolean). Hoe kan ik voorkomen dat de decimale waarden in de kolom ook worden geconverteerd naar foute waarden?

 

[VenA]

Plaats een voorbeeldbestand.

 

[KPTPTT]

Even lastig geweest maar bijgaande de het gecompileerde Excel bestand. Vanwege de beperkingen heb ik de bestand extensie gewijzigd van .xlsm naar .txt,. (Let op m!) Deze graag even aanpassen.

 

[SjonR]

prachtig voorbeeld. Er staan alleen maar binaire getallen in B6:B26

Maar probeer het zo eens:

 For Each cl In Worksheets("Voorkamer").Range("B6:B24")
        If VarType(cl) = vbBoolean Then cl.Value = IIf(cl, 1, 0)
   Next

 

[VenA]

Ander idee.

Sub VenA()
  For Each cl In UsedRange.SpecialCells(2, 4)
    cl.Value = Abs(cl)
  Next cl
End Sub

 

[KPTPTT]

Top. Jullie zijn ware kunstenaars . Het werkt (sub VenA en van SjonR), echter de code van VenA begrijp ik niet zo. Dank jullie wel.

 

[KPTPTT]

Het gaat toch helaas niet goed met de volgende code:

For Each cl In Worksheets("Keuken").UsedRange.SpecialCells(2, 4)   ' Voor elke cel wordt gecontroleerd op Boolean waarde en geconverteerd naar binaire waarde 1 of 0
    cl.Value = Abs(cl)
    Next cl

For Each cl . . . wordt fout gemerkt met de foutmelding 1004:" Er zijn geen cellen gevonden". De eerste keer ging het goed, daarna niet meer. Ik heb ook andere tabbladen uitgevoerd maar ook bij de eerstvolgende een fout.
Hetzelfde geldt ook voor de code van SjonR. Ik zie ook dat alle cellen van de sheet worden geconverteerd.

 

[SjonR]

welke fout?

In je voorbeeldbestand werken de codes maar kennelijk in je "echte" bestand niet?

 

[VenA]

Als er geen spcialcells zijn krijg je inderdaad een melding. Dit kan je ondervangen met

 on error resume next

. Leg eens uit wat je nu eigenlijk wil en plaats een relevant voorbeeld bestand. (je kan gewoon een .xlsm plaatsen) Je hebt nu 2 vragen open staan over hetzelfde bestand wat niet wenselijk is.

of bedoel je dit met al jouw vraagstukken?

Sub VenA()
  ar = Sheets("voorkamer").Cells(1).CurrentRegion
  For j = 2 To UBound(ar)
    For jj = 1 To UBound(ar, 2)
    ar(j, jj) = IIf(VarType(ar(j, jj)) = vbBoolean, Abs(ar(j, jj)), ar(j, jj))
    Next jj
  Next j
  Sheets("Sheet1").Cells(1).Resize(UBound(ar, 2), UBound(ar)) = Application.Transpose(ar)
End Sub

 

[SjonR]

dit worden lange draadjes ben ik bang.....

 

[VenA]

@SjonR,
De oplossing staat toch in #15? Alleen nog een bedankje en beide draadjes kunnen op slot. Maar het zal toch wel weer anders zijn.

 

[SjonR]

@VenA

Ik ben niet de TS

 

[VenA]

@SjonR, weet ik. Berichtje aangepast voor de duidelijkheid. Zitten we al bijna op pagina 2 voor een ogenschijnlijke simpele vraag.:d

 

[SjonR]

of de oplossing überhaupt bestaat ????????