Moderatori: Anthony47, Flash30005
luca62 ha scritto:dove xxxxxx sono una serie di caratteri
da cui dedurre, per cominciare,di che tipo di file si tratta.Flash ha scritto:Sarebbe opportuno che inviassi un file esempio
Sub MassMod()
Dim myOrigin, myRep, myPath As String, C As Range
Dim I As Long, J As Long, myCnt() As Long, myFile As String
'
myPath = "D:\PIPPO\4LUCA" '<<< La directory dove si trovano i file da lavorare
myOrigin = Array("ISO 4017 8.8", "ISO 4762 8.8") '<<< I Termini da cercare
myRep = Array("TE UNI 5739", "TCCE UNI 5931") '<<< I Termini sostitutivi
'
ReDim myCnt(LBound(myOrigin, 1) To UBound(myOrigin, 1))
'
myFile = Dir(myPath & "\*.xls*")
Do Until myFile = ""
Erase myCnt
ReDim myCnt(LBound(myOrigin, 1) To UBound(myOrigin, 1))
'
Workbooks.Open (myPath & "\" & myFile)
For I = 1 To ActiveWorkbook.Worksheets.Count
Worksheets(I).Select
With ActiveSheet.UsedRange
For J = LBound(myOrigin, 1) To UBound(myOrigin, 1)
Set C = .Find(myOrigin(J), LookIn:=xlValues, lookat:=xlPart)
If Not C Is Nothing Then
firstAddress = C.Address
Do
If InStr(1, C.Value, myRep(J), vbTextCompare) = 0 Then
myCnt(J) = myCnt(J) + 1
C.Value = Replace(C.Value, myOrigin(J), myRep(J), , , vbTextCompare)
End If
Set C = .FindNext(C)
Loop While Not C Is Nothing 'And C.Address <> firstAddress
End If
Next J
End With
Next I
ActiveWorkbook.Close True
With ThisWorkbook.Sheets("Foglio1")
mynext = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(mynext, 1) = myFile
.Cells(mynext, 2) = myCnt(LBound(myCnt, 1))
.Cells(mynext, 3) = myCnt(LBound(myCnt, 1) + 1)
End With
myFile = Dir
Loop
MsgBox ("Completato...")
End Sub
Torna a Applicazioni Office Windows
Macro modifica date scelta periodo Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 11 |
Inserire dati filtrati da 2 file ad un terzo file Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 14 |
Supporto per sviluppo macro VBA Ordinare per data Autore: Carletto Ribolla |
Forum: Applicazioni Office Windows Risposte: 3 |
Visitano il forum: Nessuno e 27 ospiti