Moderatori: Anthony47, Flash30005
Sub puliscizona()
Set currentCell = Worksheets("foglio2").Range("B6")
Do While Not IsEmpty(currentCell)
Set nextCell = currentCell.Offset(1, 0)
If nextCell.Value = currentCell.Value Then
currentCell.ClearContents
End If
Set currentCell = nextCell
Loop
Range("B7").Select
End Sub
=SE(G6="";"";A6/G6)
Sub EliminaDoppie()
Dim Str1, Str2 As String
UR = Range("A" & Rows.Count).End(xlUp).Row
Str1 = ""
Str2 = ""
For ST = 1 To 6
If ST <> 2 Then '<<<<<<<<<<<<<<<<<<<<< Togliere nel caso voglia controllare anche il valore nella colonna B
Str1 = Str1 & Cells(UR - 1, ST).Value
Str2 = Str2 & Cells(UR, ST).Value
If Str1 = Str2 Then Range("A" & UR & ":G" & UR).ClearContents
End If '<<<<<<<<<<<<<<<<<<<<< Togliere nel caso voglia controllare anche il valore nella colonna B
Next ST
End Sub
Private Sub ImportTextFile(FName As String, Sep As String)
Dim RowNdx As Long
Dim ColNdx As Integer
Dim TempVal As Variant
Dim WholeLine As String
Dim Pos As Integer
Dim NextPos As Integer
Dim SaveColNdx As Integer
Dim sh As Worksheet
Dim RngIn As Range
Dim RngOut As Range
Dim iRow As Long
Dim CalcMode As Long
Application.ScreenUpdating = False
'On Error GoTo EndMacro:
Call EliminaDoppie
Worksheets("Foglio1").Activate
Range("$A$1:$g$1").Select
Selection.ClearContents
SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.Row
FName = "C:\Users\giancarlo\AppData\Local\VirtualStore\Program Files\Alpari ÌÒ4\experts\files\EURUSD.txt"
Open FName For Input Access Read As #1
While Not EOF(1)
Line Input #1, WholeLine
If Right(WholeLine, 1) <> Sep Then
WholeLine = WholeLine & Sep
End If
ColNdx = SaveColNdx
Pos = 1
NextPos = InStr(Pos, WholeLine, Sep)
While NextPos >= 1
TempVal = Mid(WholeLine, Pos, NextPos - Pos)
Cells(RowNdx, ColNdx).Value = TempVal
Pos = NextPos + 1
ColNdx = ColNdx + 1
NextPos = InStr(Pos, WholeLine, Sep)
Wend
RowNdx = RowNdx + 1
Wend
EndMacro:
On Error GoTo 0
Close #1
Range("$a$2:$g$2").Select
Selection.Copy
Worksheets("Foglio2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True
'Call EliminaDoppie
Call mStart
End Sub
Sub EliminaDoppie()
Worksheets("Foglio2").Activate
Dim Str1, Str2 As String
UR = Range("A" & Rows.Count).End(xlUp).Row
Str1 = ""
Str2 = ""
For ST = 1 To 6
If ST <> 2 Then '<<<<<<<<<<<<<<<<<<<<< Togliere nel caso voglia controllare anche il valore nella colonna B
Str1 = Str1 & Cells(UR - 1, ST).Value
Str2 = Str2 & Cells(UR, ST).Value
If Str1 = Str2 Then Range("A" & UR & ":G" & UR).ClearContents
End If '<<<<<<<<<<<<<<<<<<<<< Togliere nel caso voglia controllare anche il valore nella colonna B
Next ST
End Sub
Sub EliminaDoppioni()
'Questo codice ordina i dati nella seconda
'colonna del foglio Dati ed elimina le righe che 'contengono dati duplicati.
Application.ScreenUpdating = False
Range("B4:B800").Select
Selection.Sort Key1:=Range("B4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Set currentCell = Worksheets("Dati").Range("B4")
Do While Not IsEmpty(currentCell)
Set nextCell = currentCell.Offset(1, 0)
If nextCell.Value = currentCell.Value Then
currentCell.EntireRow.Delete
End If
Set currentCell = nextCell
Loop
Range("B4").Select
End Sub
Sub Remove()
Worksheets("Foglio2").Select
Range("A6:g1000").Select
ActiveSheet.Range("$A$6:$g$1000").RemoveDuplicates Columns:=2, Header:= _
xlYes
End Sub
Torna a Applicazioni Office Windows
Visitano il forum: Nessuno e 89 ospiti