Een getal in een range vervangen door een woord

Status
Niet open voor verdere reacties.
jobefox

jobefox

Gebruiker
Lid geworden
12 aug 2012
Berichten
8
Ik ben nieuw in VBA en heb de volgende vraag.:(
In mijn Sheet heb ik twee kolommen, namelijk kolom E en I.
In deze kolommen hebben sommige cellen een waarde (getallen van 1 tot 100).
Ieder getallen komt overeen met een bepaald status (woord).
Nu zou ik de getallen door het des betreffende staus (wpprd) willen vervangen.
Heeft iemand hiervoor een VBA oplossing
Code Status
11 AA
24 CA
51 DDD
52 AB
.... ....
Alvast bedankt
 
Haal de fouten even uit je verhaal want dat maakt vervelend lezen.
Daarnaast is een voorbeeld document wel op z'n plaats.
 
Zoiets?
Code: 
Sub dotchie()
Dim rCell As Range
Dim rRng As Range
Dim fndList As Variant
Dim rplcList As Variant
Dim x As Long
Set rRng = Sheets("Blad1").Range("E2:E1000,I2:I1000")
fndList = Array("11", "24", "51", "52")
rplcList = Array("AA", "CA", "DDD", "AB")
For x = LBound(fndList) To UBound(fndList)
    
        For Each rCell In rRng.Cells
        rCell.Replace What:=fndList(x), Replacement:=rplcList(x), _
          LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
          SearchFormat:=False, ReplaceFormat:=False
      Next rCell
  
  Next x
End Sub
 
@Dotchie

Zonder enige lus een heel werkblad:

Code: 
cells.replace "x","y"
 
Aangepaste vraagstelling

Edmoor,
Bedankt voor de reactie.
Er staan inderdaad wat slordigheden in.
Hierna een nieuwe poging.

Uit vier bestaande Workbooks wordt er in de Workbook "Week_XX" een nieuwe Sheet gegenereerd (Week_X) met een weekoverzicht en waar de gegevens per dag kunnen worden gesorteerd.
Vervolgens worden er in de Workbook (Week_XX) per dag een Sheet (Dag 1, Dag 2,Dag 3...) gegenereerd met de gegevens uit de Sheet Week_X.

In de Sheets Dag 1, Dag 2, Dag 3.... bevatten de cellen in kolommen D en I de namen van de personeelsleden en in kolommen E en J de code voor diegene die afwezig zijn. De afwezigheidscode's zijn een getal tussen nul en honderd.

De afwezigheidscodes zijn nogal persoonlijk en die wil ik vervangen door een omschrijving ( ziek, opleiding, recuperatie...)
Bijvoorbeeld:
33 = ziek thuis
51 = ziek thuis
65 = opleiding intern
77 = opleiding extern

Dus hoe kan ik, met VBA, deze codes omzetten in een omschrijving?

Ik hoop dat de vraag nu wat duidelijker is gesteld.
Bekijk bijlage Week_XX.xlsx
Alvast bedankt
 
Je kan ze wel vervangen met VBA maar dan ziet de layout er niet meer uit. Je kan beter op een ander blad een tabelletje maken met de code en in een cel ernaast de omschrijving. Vervolgens kan je dan VERT.ZOEKEN gebruiken om de omschrijving bij de code te halen. Daar is dus geen VBA voor nodig.
Je zal wel wat aan de layout moeten doen.
 
@ gast0660
@ snb

Ga morgen beide oplossingen testen ;-)
Zal wel een lange array worden... ;-)
Mercikes
 
@edmoor
Jammer genoeg moet de layout behouden worden, maar mss de "array" in een tabel zetten als een range.
Ik zal het eens bekijken vanuit die invalhoek.
 
Zodra je die cijfers gaat vervangen door een tekst zijn die cellen veel te smal. Dat bedoel ik met die layout.
 
@ edmoor
Dan is de layout geen probleem, dat los ik wel op ;-)
 
gast0660 zei:
Zoiets?
Code: 
Sub dotchie()
Dim rCell As Range
Dim rRng As Range
Dim fndList As Variant
Dim rplcList As Variant
Dim x As Long
Set rRng = Sheets("Blad1").Range("E2:E1000,I2:I1000")
fndList = Array("11", "24", "51", "52")
rplcList = Array("AA", "CA", "DDD", "AB")
For x = LBound(fndList) To UBound(fndList)
    
        For Each rCell In rRng.Cells
        rCell.Replace What:=fndList(x), Replacement:=rplcList(x), _
          LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
          SearchFormat:=False, ReplaceFormat:=False
      Next rCell
  
  Next x
End Sub
Klik om te vergroten...

Voor de range E2:E1000 werkt het, maar niet voor de range I2:I1000 ;-)
 
Je hebt hieraan dan toch genoeg ?

Code: 
Sub M_snb()
  sn= split("AA CA DDD AB")

  with Sheets("Blad1").Range("E2:E1000,I2:I1000")
     for j=0 to 100
       .replace j,sn(j)
      next
   end witg
End Sub
 
Laatst bewerkt:
Beide oplossingen werken.
Volgende week ga ik nog wat experimenteren en dan laat ik jullie weten wat mijn uiteindelijke keuze is.
Alvast bedankt
 
Mijn oplossing, graag jullie mening...

Ter info:
Er waren bijna 30 codes te vervangen (tussen 1 en 100).
Daarom heb ik, om het overzichtelijk te houden, geen gebruik gemaakt van een array.


Code: 
  ' ---------------------------------------------------------
    '   De afwezigheidscodes vervangen door een omschrijving
	'	De target Sheets zijn Dag 1, Dag 2, Dag 3...
	' 	Source Sheet is de Sheet Data
	' 	Een tabel met gegevens staat in de Sheet Data, 
	'	de codes staan in kolom C van Sheet Data
	'	de omschrijvingen staan in de kolom D van de Sheet Data
    ' ----------------------------------------------------------
    '
    Dim strOmschrijving As String
    Dim rngCode As String
    Dim rngCodeValue As Integer
    Dim iDag As Integer
    Dim iDispAfw As Integer
    '
    ' START  VERVANG CODE
    iDag = 1
    For iDag = 1 To 7
        Sheets("Dag " & iDag).Activate ' Activeer Sheet DagX
		' en doe het volgende
		'--------------------------
        ' START LOOP DISP
        iDispAfw = 1
        For iDispAfw = 1 To 17 Step 1
			' De cellen met inhoud zijn allemaal benoemd,
			' cel B3 = DispAfw1, B7 = DispAfw6...
            rngCodeValue = Sheets("Dag " & iDag).Range("DispAfw" & iDispAfw).Value ' bvb. Sheet = Dag 1, Range = DispAfw1
            If Range("DispAfw" & iDispAfw) = "" Then
            Else
				' Activeer Sheet Data met de tabel van de codes
                Sheets("Data").Activate 
                Sheets("Data").Select
                With Sheets("Data").Range("C2:C37") ' in kolom C staan de cijfer codes
                    Set rng2 = .Find(What:=rngCodeValue, _
                        LookIn:=xlFormulas, _
                            LookAt:=xlWhole)
					' in kolom D staan de omschrijvingen,
                    rngOmschrijving = rng2.Offset(0, 1) 
                    If Not rng2 Is Nothing Then ' als de code gevonden is...
                        Sheets("Dag " & iDag).Activate
                        Sheets("Dag " & iDag).Range("DispAfw" & iDispAfw).Select
                        Selection = rngOmschrijving
                    End If
                End With
            End If
        Next ' EINDE LOOP DISP
		' -------------------------
        ' START LOOP NW
        iNwAfw = 1
        For iNwAfw = 1 To 12 Step 1
            rngCodeValue = Sheets("Dag " & iDag).Range("NwAfw" & iNwAfw).Value
            If Range("NwAfw" & iNwAfw) = "" Then
            Else
                Sheets("Data").Activate ' Activeer Data Sheet met de tabel van de codes
                Sheets("Data").Select
                With Sheets("Data").Range("C2:C37")
                    Set rng2 = .Find(What:=rngCodeValue, _
                        LookIn:=xlFormulas, _
                            LookAt:=xlWhole)
                    rngOmschrijving = rng2.Offset(0, 1)
                    If Not rng2 Is Nothing Then ' als de code gevonden is...
                        Sheets("Dag " & iDag).Activate
                        Sheets("Dag " & iDag).Range("NwAfw" & iNwAfw).Select
                        Selection = rngOmschrijving
                    End If
                End With
            End If
        Next ' EINDE LOOP NW
    Next ' EINDE VERVANG CODE
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan