Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Sub Replace430()
- Dim MyRange As Range
- Dim RowCount As Long
- Dim ColCount As Integer
- Dim MyArray() As Variant
- Dim i, j, k, percent30 As Long
- Dim Count4 As Long
- Const Replaced = 0 'Set Replaced Value
- Const found = 18 'Set Find Value
- Const Mycol = 3 'Correctly set the Column Number of Column in Range where 4 is to be checked
- Set MyRange = Range("B2:F23")
- RowCount = MyRange.Rows.Count
- ColCount = MyRange.Columns.Count
- 'Get number of 4's againts 18
- For i = 1 To RowCount
- If MyRange.Columns(1).Cells(i) = found Then
- For j = Mycol To Mycol
- If MyRange.Columns(j).Cells(i) = 4 Then
- Count4 = Count4 + 1
- End If
- Next j
- End If
- Next i
- ReDim MyArray(Count4 - 1, 2)
- k = 0
- For i = 1 To RowCount
- If MyRange.Columns(1).Cells(i) = found Then
- For j = Mycol To Mycol
- If MyRange.Columns(j).Cells(i) = 4 Then
- MyArray(k, 1) = i
- MyArray(k, 2) = j
- k = k + 1
- End If
- Next j
- End If
- Next i
- percent30 = 0.3 * Count4
- Dim shufflearray()
- ReDim shufflearray(Count4 - 1)
- For i = 0 To Count4 - 1
- shufflearray(i) = i
- Next i
- 'Shuffle the shufflearray() below
- Dim N As Long
- Dim Temp As Variant
- Randomize
- For N = LBound(shufflearray) To UBound(shufflearray)
- j = CLng(((UBound(shufflearray) - N) * Rnd) + N)
- If N <> j Then
- Temp = shufflearray(N)
- shufflearray(N) = shufflearray(j)
- shufflearray(j) = Temp
- End If
- Next N
- 'Use randomised values from shufflearray as array subscript to replace only 30% of 4's
- For i = 0 To percent30 - 1
- MyRange.Columns(MyArray(shufflearray(i), 2)).Cells(MyArray(shufflearray(i), 1)).Value = Replaced
- Next i
- End Sub
Add Comment
Please, Sign In to add comment