Γεια σου Mtornado,
Για να αφαιρέσετε τις περίπλοκες τιμές κάθε 10 κελιά, κάντε τα εξής:
- Στο φύλλο εργασίας σας, πατήστε άλλος + F11, στη συνέχεια κάντε κλικ στο κουμπί Κύριο θέμα > Μονάδα μέτρησης;
- Αντιγράψτε τον παρακάτω κώδικα και επικολλήστε τον στο πλαίσιο της μονάδας.
- Τύπος F5 για να εκτελέσετε τον κώδικα, τότε θα δείτε α Kutools για Excel διαλόγου όπως φαίνεται παρακάτω:
- Επιστρέψτε στο φύλλο εργασίας σας και επιλέξτε την περιοχή. Στη συνέχεια κάντε κλικ στο OK κουμπί στο παράθυρο διαλόγου.
Sub RemoveDuplicatesValue_10()
Dim xSltRg, xCells, xRg As Range
Dim xStartRg, xEndRg As Range
Dim xSInt, xCount, xRntInt, xNumInt, xF As Integer
On Error Resume Next
xSInt = 10
Set xSltRg = Application.InputBox("Select range:", "Kutools for Excel", , , , , , 8)
If xSltRg Is Nothing Then Exit Sub
Set xSltRg = Application.Intersect(ActiveSheet.UsedRange, xSltRg)
Set xSltRg = Application.Union(xSltRg, xSltRg.Item(1))
xCount = xSltRg.Count
xNumInt = Int(xCount / xSInt)
xRntInt = 0
xRntInt = xCount Mod xSInt
For xF = 1 To xNumInt
Set xStartRg = xSltRg.Item(((xF - 1) * xSInt + 1))
Set xEndRg = xSltRg.Item(xF * xSInt)
Set xCells = xSltRg.Worksheet.Range(xStartRg.AddressLocal & ":" & xEndRg.AddressLocal)
For xInt = xCells.Count To 1 Step -1
Set xRg = xCells.Item(xInt)
If WorksheetFunction.CountIf(xCells, xRg.Value) > 1 Then
xRg.Value = ""
End If
Next
Next
If xRntInt > 0 Then
Set xStartRg = xSltRg.Item(xNumInt * xSInt + 1)
Set xEndRg = xSltRg.Item(xCount)
Set xCells = xSltRg.Worksheet.Range(xStartRg.AddressLocal & ":" & xEndRg.AddressLocal)
For xInt = xCells.Count To 1 Step -1
Set xRg = xCells.Item(xInt)
If WorksheetFunction.CountIf(xCells, xRg.Value) > 1 Then
xRg.Value = ""
End If
Next
End If
End Sub
Σημειώστε ότι για να αφαιρέσετε τις διπλότυπες τιμές κάθε N κελιά, αλλάξτε το 10 στον κώδικα σε N.
Amanda