gehel rij ipv ActiveCell

Status
Niet open voor verdere reacties.

Catotjuh91

Nieuwe gebruiker
Lid geworden
11 mei 2015
Berichten
2
Ik heb hulp nodig met het onderstaande VBA script.
Als ik dit script gebruik kan ik het alleen maar per cell doen in excel terwijl ik graag in 1x de gehele rij zou willen genereren.
Weet iemand hoe dit moet?
Alvast bedankt.

Sub SetGrades()

Dim score As Integer

score = ActiveCell.Value

Select Case score

Case 0 To 50.3778337531486
ActiveCell(1, 2).Value = "TI"
ActiveCell(1, 2).HorizontalAlignment = xlCenter

Case 50.3778337531487 To 176.32241813602
ActiveCell(1, 2).Value = "ARI"
ActiveCell(1, 2).HorizontalAlignment = xlCenter

Case 176.32241813603 To 251.889168765743
ActiveCell(1, 2).Value = "PRI"
ActiveCell(1, 2).HorizontalAlignment = xlCenter

Case 251.889168765744 To 302.267002518892
ActiveCell(1, 2).Value = "TI unknown"
ActiveCell(1, 2).HorizontalAlignment = xlCenter

Case 302.267002518892 To 428.211586901763
ActiveCell(1, 2).Value = "ARI unknown"
ActiveCell(1, 2).HorizontalAlignment = xlCenter

Case 428.211586901764 To 503.778337531486
ActiveCell(1, 2).Value = "PRI unknown"
ActiveCell(1, 2).HorizontalAlignment = xlCenter

Case 503.778337531487 To 508.816120906801
ActiveCell(1, 2).Value = "TI emergency"
ActiveCell(1, 2).HorizontalAlignment = xlCenter

Case 508.816120906802 To 518.891687657431
ActiveCell(1, 2).Value = "ARI emergency"
ActiveCell(1, 2).HorizontalAlignment = xlCenter

Case 518.891687657432 To 528.96725440806
ActiveCell(1, 2).Value = "PRI emergency"
ActiveCell(1, 2).HorizontalAlignment = xlCenter

Case 528.96725440807 To 609.571788413098
ActiveCell(1, 2).Value = "SK"
ActiveCell(1, 2).HorizontalAlignment = xlCenter

Case 609.571788413099 To 739.478589420655
ActiveCell(1, 2).Value = "FE"
ActiveCell(1, 2).HorizontalAlignment = xlCenter

Case 739.478589420656 To 881.612090680101
ActiveCell(1, 2).Value = "PRF"
ActiveCell(1, 2).HorizontalAlignment = xlCenter

Case 881.612090680102 To 982.367758186398
ActiveCell(1, 2).Value = "FRD"
ActiveCell(1, 2).HorizontalAlignment = xlCenter

Case 982.367758186399 To 984.886649874055
ActiveCell(1, 2).Value = "SK emergency"
ActiveCell(1, 2).HorizontalAlignment = xlCenter

Case 984.886649874056 To 989.92443324937
ActiveCell(1, 2).Value = "FE emergency"
ActiveCell(1, 2).HorizontalAlignment = xlCenter

Case 989.92443324938 To 994.962216624685
ActiveCell(1, 2).Value = "PRF emergency"
ActiveCell(1, 2).HorizontalAlignment = xlCenter

Case 994.962216624686 To 1000
ActiveCell(1, 2).Value = "FRD emergency"
ActiveCell(1, 2).HorizontalAlignment = xlCenter

Case Else
MsgBox "No score entered"

End Select

End Sub
 
Probeer dit eens:
Code:
Sub SetGrades()
    With Cells(1, 2)
        Select Case ActiveCell
            Case 0 To 50.3778337531486:                 .Value = "TI"
            Case 50.3778337531487 To 176.32241813602:   .Value = "ARI"
            Case 176.32241813603 To 251.889168765743:   .Value = "PRI"
            Case 251.889168765744 To 302.267002518892:  .Value = "TI unknown"
            Case 302.267002518892 To 428.211586901763:  .Value = "ARI unknown"
            Case 428.211586901764 To 503.778337531486:  .Value = "PRI unknown"
            Case 503.778337531487 To 508.816120906801:  .Value = "TI emergency"
            Case 508.816120906802 To 518.891687657431:  .Value = "ARI emergency"
            Case 518.891687657432 To 528.96725440806:   .Value = "PRI emergency"
            Case 528.96725440807 To 609.571788413098:   .Value = "SK"
            Case 609.571788413099 To 739.478589420655:  .Value = "FE"
            Case 739.478589420656 To 881.612090680101:  .Value = "PRF"
            Case 881.612090680102 To 982.367758186398:  .Value = "FRD"
            Case 982.367758186399 To 984.886649874055:  .Value = "SK emergency"
            Case 984.886649874056 To 989.92443324937:   .Value = "FE emergency"
            Case 989.92443324938 To 994.962216624685:   .Value = "PRF emergency"
            Case 994.962216624686 To 1000:              .Value = "FRD emergency"
            Case Else
                MsgBox "No score entered"
        End Select
    End With
    ActiveSheet.Columns("A").Cells.HorizontalAlignment = xlCenter
End Sub
 
Laatst bewerkt:
Dan zet je er een lus omheen.

Code:
sub hsv()
dim cl as range
For each cl in columns(1).specialcells(2)
select case cl.value

case 0 to 50.3778337531486
cl.offset(,1).value = blabla

case enz

end select
next cl
columns(2).HorizontalAlignment = xlCenter
end sub
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan