Ciao,
hai ragione, pensavo che bastasse un ragionamento generico, comunque metto sotto tutto il codice, partendo dall'importazione dei file fino all'inizio della parte di calcolo.
Personalmente nn credo sia molto utile per la soluzione del problema, comunque ecco il codice (ovviamente in vba per excel) in 2 parti perchè è troppo lungo:
PARTE!
================================================== =======
Private Sub CommandButton1_Click()
'Defizione delle variabili e loro iniziazione
Dim Dir As String
Dim FileName As String
Dim DirName As String
Dim CompDirFile As String
Dim NumFile As Integer 'conta il numero di file da importare
Sheets("Lista_file_da_importare").Select
NumFile = ActiveSheet.Cells(1, 2).End(xlDown).Row 'Con la funzionalità END si trova l'ultima cella con valori
Dim i As Integer 'valore che scorre i vari nome dei file da importare
Dim Rig As Integer 'Variabile usata per contare le righe su cui fare la trasformazione e i vari conti
Dim c As Integer 'Variabile usata per scorrere le celle su cui fare i conti (arriverà fino ad un valore pari a R)
Dim c1 As Integer ' Cella istantanea su cui eseguo il conto
Dim tup As Double 'Tratto utile provino
tup = Sheets("Dati_provino").Cells(1, 2)
Dim sez As Double 'sezione provino
sez = Sheets("Dati_provino").Cells(4, 2)
Dim deltaL As Double 'delta L calcolato dalla macchina di prova
Dim F As Double 'Forza registrata dalla macchina di prova
Dim epselonENG As Double 'allungamento ingegneristico
Dim sigmaENG As Double 'sigma ingegneristico
Dim sigmaTRUE As Double 'sigma reale
Dim epselonTRUE As Double 'epselon reale
Dim epselon002 As Double 'variabile che definisce l'allungamento allo 0.2% e serve per calcolare E
Dim sigma002 As Double 'variabile che definisce lo sforzo quando l'allungamento è 0.2% e serve per calcolare E
Dim E As Double 'modulo elastico
Dim A As Double 'variabile che serve per il calcolo di epselonENG
Dim prima As Integer 'variabile che serve per togliere evidenziatore durante identificazione all. 0.2%
For i = 2 To NumFile
FileName = Sheets("Lista_file_da_importare").Cells(i, 3)
DirName = Sheets("Lista_file_da_importare").Cells(i, 2)
CompDirFile = DirName & "/" & FileName
'' IMPORTAZIONE E TRATTAMENTO DATI
'Seleziono il file da importare e creo il suo foglio nel'importazione
Sheets("Lista_file_da_importare").Select
Sheets.Add.Name = FileName
ActiveSheet.Move After:=Sheets("Lista_file_da_importare")
ActiveSheet.Cells(1, 1).Select
'Operazioni di copiatura dei dati
ChDir DirName
Workbooks.OpenText FileName:=CompDirFile _
, Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True
ActiveSheet.Columns("A:B").Select
Selection.Copy
Windows("Importazione_automatica_dati.xls").Activa te
ActiveSheet.Paste
ActiveSheet.Rows("1:1").Select
Selection.Insert Shift:=xlDown
ActiveSheet.Range("A1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "F [N]"
ActiveSheet.Range("B1").Select
'Parte che serve per scrivere le intestazioni dell righe con l'alfabeto greco
ActiveCell.FormulaR1C1 = "DL [mm]"
With ActiveCell.Characters(Start:=1, Length:=1).Font
.Name = "Symbol"
.FontStyle = "Normale"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With ActiveCell.Characters(Start:=2, Length:=3).Font
.Name = "Arial"
.FontStyle = "Normale"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With ActiveCell.Characters(Start:=5, Length:=1).Font
.Name = "Symbol"
.FontStyle = "Normale"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With ActiveCell.Characters(Start:=6, Length:=2).Font
.Name = "Arial"
.FontStyle = "Normale"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
ActiveSheet.Range("C1").Select
ActiveCell.FormulaR1C1 = "DL[mm]"
With ActiveCell.Characters(Start:=1, Length:=1).Font
.Name = "Symbol"
.FontStyle = "Normale"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With ActiveCell.Characters(Start:=2, Length:=6).Font
.Name = "Arial"
.FontStyle = "Normale"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
ActiveSheet.Range("C2").Select
ActiveCell.FormulaR1C1 = "=RC[-1]/1000"
ActiveSheet.Range("C2").Select
'Variabile per avere la stessa formula fino all'ultima riga
Rig = ActiveSheet.Cells(1, 2).End(xlDown).Row
'Calcolo variabili ingegneristiche
For c = 2 To Rig
c1 = ActiveSheet.Cells(c, 2) 'variabile che definisce il valore in microm
ActiveSheet.Cells(c, 3) = c1 / 1000 'trasformazione da microm a mm
'Calcolo del DeltaL e epselon ingegneristica
deltaL = ActiveSheet.Cells(c, 3)
epselonENG = deltaL / tup
ActiveSheet.Cells(c, 5) = epselonENG
'Calcolo sigma ingegneristica
F = ActiveSheet.Cells(c, 1)
sigmaENG = F / sez
ActiveSheet.Cells(c, 6) = sigmaENG
' Ciclo per il calcolo dell'allungamento allo 0.2% e del modulo elastico
If epselonENG <= 0.002 And epselonENG > 0 Then
epselon002 = epselonENG
sigma002 = sigmaENG
E = sigma002 / epselon002
'tolgo evidenziatore a cella precedente
prima = c - 1
ActiveSheet.Cells(prima, 6).Select
With Selection.Interior
.ColorIndex = xlNone
End With
ActiveSheet.Cells(prima, 5).Select
With Selection.Interior
.ColorIndex = xlNone
End With
'evidenzio cella attuale
ActiveSheet.Cells(c, 6).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
ActiveSheet.Cells(c, 5).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
End If
Next c
'Calcolo variabili Reali come richiesto dal file input di Abaqus
For c = 2 To Rig
'Calcolo sigma TRUE
sigmaTRUE = ActiveSheet.Cells(c, 6) * (1 + epselonENG)
ActiveSheet.Cells(c, 8) = sigmaTRUE
'Calcolo epselon TRUE
'Le prime due righe di seguito usano la formula corretta, ma poichè si hanno valori
'negativi, di comune accordo con l'assistenza di abaqus abbiamo tolto il termine sigma / E
'epselonTRUE = A - (sigmaTRUE / E)
A = WorksheetFunction.Ln(1 + ActiveSheet.Cells(c, 5))
epselonTRUE = A
ActiveSheet.Cells(c, 7) = epselonTRUE
Next c
'Inserisco le righe e le colonne che spostano tutto il foglio in modo da poter scrivere le varie
'variabili di interesse
ActiveSheet.Columns("A:A").Select
Selection.Insert Shift:=xlToRight
ActiveSheet.Rows("1:1").Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown

Rispondi quotando