|
|
|
![]() |
|
Strumenti |
![]() |
#1 |
Member
Iscritto dal: Jan 2006
Messaggi: 225
|
[Excel Vb] Controllo valori
Ciao a tutti, premetto che di excel ci ho sempre capito poco, ma mi è stata rifilata una magagna che devo risolvere, e non ho il tempo materiale di documentarmi per imparare le tonnellate di cose che non conosco
![]() In pratica mi è stato consegnato un file excel con dentro varie macro, che svolgono diverse funzioni relative all'apertura e controllo di vari fogli contenuti in diversi file. Devo scrivere una sub che viene attivata in caso di errore nel check di alcuni valori (in pratica se nelle celle di determinate colonne è contenuto un valore stringa invece di un reale). Questa sub deve trovare le celle contenenti delle stringhe, ed il contenuto deve diventare il commento della cella in questione (esempio, se la cella a3 contiene il valore xyz4 questo deve diventare il suo commento, lasciandola vuota). Considerato che nel momento in questa sub viene attivata io stò già lavorando nel foglio contenente l'errore devo trovare un modo per controllare quali celle di varie colonne presentano l'errore, e successivamente fare quanto scritto sopra) ![]() Spero che qualcuno mi possa aiutare perchè sono davvero alla frutta. Se vi serve saperlo uso office 2003 |
![]() |
![]() |
![]() |
#2 |
Senior Member
Iscritto dal: Jul 2007
Messaggi: 1092
|
Premesso che non sono una cima di vba, una sub del genere dovrebbe andare bene.
Codice:
Sub stringhe() For Each cella In Selection.Cells If Not IsNumeric(cella.Value) Then cella.AddComment cella.Comment.Visible = False cella.Comment.Text Text:=cella.Value cella.Value = "" End If Next End Sub ![]() |
![]() |
![]() |
![]() |
#3 |
Member
Iscritto dal: Jan 2006
Messaggi: 225
|
E' possibile applicare il comando
For each cells in (colonna) ?? questo risolverebbe il problema completamente! ^^ grazie mille per la risposta! |
![]() |
![]() |
![]() |
#4 |
Senior Member
Iscritto dal: Jul 2007
Messaggi: 1092
|
Per una sola colonna
For Each cella In ActiveSheet.Range("A:A") Questa invece esegue la macro sulle colonne A e B ![]() For Each cella In ActiveSheet.Range("A:B") |
![]() |
![]() |
![]() |
#5 |
Member
Iscritto dal: Jan 2006
Messaggi: 225
|
Chiarissimo!!!
Ora, io sò che la prima riga utilizzata è la 4, e l'ultima viene determinata da un'altra routine chiamata tab_valori(3) Quindi, per fare il controllo sulla colonna dalla riga che mi interessa fino a quella dovrei scrivere così? For Each cells in ActiveSheet.Range("A4: Atab_valori(3)") ? |
![]() |
![]() |
![]() |
#6 |
Senior Member
Iscritto dal: Jul 2007
Messaggi: 1092
|
Dovrebbe essere così
For Each cells in ActiveSheet.Range("A4:A" & tab_valori(3)) |
![]() |
![]() |
![]() |
#7 |
Member
Iscritto dal: Jan 2006
Messaggi: 225
|
In effetti sembra funzionare!!! grazie mille per l'aiuto che mi hai dato!!
Uff mi hanno rifilato una seconda routine da fare -_- provo a farla da solo! nel caso posso chiederti nuovamente qualche suggerimento per favore? Ora scappo che vado a cercarmi un libro decente su excel |
![]() |
![]() |
![]() |
#8 |
Senior Member
Iscritto dal: Jul 2007
Messaggi: 1092
|
Se potrò esserti utile volentieri, altrimenti c'è gente molto più preparata di me che sicuramente ti darà una mano.
![]() |
![]() |
![]() |
![]() |
#9 |
Member
Iscritto dal: Jan 2006
Messaggi: 225
|
La seconda (ed utilma spero) routine che mi hanno rifilato è ancora più infida della prima -_-
In pratica deve prendere dei valori contenuti in certe celle di certe colonne e copiarli in un foglio contenuto in un altro file, salvandolo e rinominandolo col nome del foglio da cui ha preso i dati delle celle. Inoltre poi deve chiudere il file da cui sono stati presi i dati senza salvarlo... |
![]() |
![]() |
![]() |
#10 | |
Senior Member
Iscritto dal: Jul 2007
Messaggi: 1092
|
Quote:
|
|
![]() |
![]() |
![]() |
#11 | |
Member
Iscritto dal: Jan 2006
Messaggi: 225
|
Quote:
Da A:4 a A & tab_valori(3) Idem con patate per le colonne D E G H J e poi vanno ricopiati nel medesimo posto in un file diverso, che deve essere rinominato (e salvato) come il file da cui vengono presi i valori , che deve essere a sua volta chiuso senza essere salvato... ... non ho la minima idea di come codificarlo ![]() |
|
![]() |
![]() |
![]() |
#12 | |
Member
Iscritto dal: Jan 2006
Messaggi: 225
|
Quote:
![]() Devo copiare TUTTE le celle, a partire dalla riga 4 fino alla riga Tab_valori(3) di tutte le colonne comprese tra A e AVV Facendo attenzione a non copiare eventuali formule ma solo i numeri. Considerato che ogni file che apre ha più fogli da copiare.. come cavolo faccio a fare in modo che questa funzione copi tutto mettendolo al posto giusto? -In pratica deve aprire un file excel -Copiare il contenuto delle celle che ho elencato sopra nella stessa posizione in cui si trovano ma in un file diverso (esempio.xls) -Salvare esempio.xls cambiandogli nome e mettendolo in uan certa directory ma lasciando il vecchio esempio.xls libero per essere riutilizzato -Chiudere il file da cui sono stati copiati i valori senza salvare Sono in panico, ho provato a studiarmi un pò di funzioni excel, credo che per la prima parte (e cioè copiare le celle) serva un metodo copy applicato ad un range.. ma non ho idea di come dirgli di andare a pescare esempio.xls e poi copiare tutti i fogli con lo stesso nome ecc ecc ![]() |
|
![]() |
![]() |
![]() |
#13 | |
Senior Member
Iscritto dal: Dec 2004
Messaggi: 3208
|
Quote:
![]() |
|
![]() |
![]() |
![]() |
#14 | |
Member
Iscritto dal: Jan 2006
Messaggi: 225
|
Quote:
![]() Cmq appena risolta questa magagna mi verrà dato del tempo per studiare excel, è assurdo lavorare in queste condizioni con delle scadenze così vicine. |
|
![]() |
![]() |
![]() |
#15 |
Member
Iscritto dal: Jan 2006
Messaggi: 225
|
in attesa di john il salvatore
![]() |
![]() |
![]() |
![]() |
#16 |
Member
Iscritto dal: Jan 2006
Messaggi: 225
|
Nessuno nessuno saprebbe darmi una manina?
![]() |
![]() |
![]() |
![]() |
#17 |
Senior Member
Iscritto dal: Dec 2004
Messaggi: 3208
|
Ok. Seguimi. Ti faccio un esempio utile.
Crea un file Excel... Nel mio esempio ho 3 Fogli, con tre tabelle dati ciascuno, che contengono sia numeri che formule. La tabella dati su ogni foglio va da A4 a D6 [ A4 : D6 ]. Il file si chiama "sorgente.xls". Lo useremo per creare "esempio.xls". Ora, devi inserire un CommandButton su Foglio1. Il codice che andrà ad eseguire il Click di CommandButton1 è questo : Codice:
Private Sub CommandButton1_Click() If ThisWorkbook.Name <> "sorgente.xls" Then Exit Sub End If SALVATAGGIO End Sub Codice:
Public Sub SALVATAGGIO() Dim percorso As String percorso = ThisWorkbook.Path & "\" Dim Foglio As Worksheet For Each Foglio In ThisWorkbook.Sheets Foglio.Select Dim Cella As Range For Each Cella In Foglio.Range("A4:" & "D6") If Left(Cella.Formula, 1) = "=" Then Cella.FormulaR1C1 = Cella.Text End If Next Next ThisWorkbook.SaveAs (percorso & "esempio.xls") End Sub ![]() |
![]() |
![]() |
![]() |
#18 |
Member
Iscritto dal: Jan 2006
Messaggi: 225
|
Ciao Marco, prima di tutto ti ringrazio per la risposta chiara ed esauriente chep roverò il prima possibile
![]() Oggi mi sono finalmente comprato un libro su excel 2003 ("Le macro di Excel 2003") Un pizzone da 500 pagine, però sembra chiaro e quindi mi servirà solo un pò di tempo per studiarlo. Oggi al lavoro hanno criticato la routine per la quale ho aperto il thread, la prima, e cioè quella per il controllo degli errori in certe colonne -_- Ti posto il codice intero, così che risulti più chiaro quanto stò per dire (fai conto che non l'ho scritto io, mi ci sono messo sopra solo dopo ![]() Codice:
Public nomefo(1 To 10) As String, numscono As Integer, tab_range(1 To 7, 1 To 2) As String, tab_valori(1 To 5), tab_mesi(1 To 12) As String Public tab_nomi(1 To 50, 1 To 2) As String, tab_bb(1 To 60, 1 To 2), tab_righe(1 To 4) As Integer Public papero As range Public erroritrovati(1 To 9) As String Public i As Integer Sub ricerca() ' nomefo(1) = ActiveWorkbook.Path & "\" nomefo(2) = ActiveWorkbook.Name nomefo(3) = "C:\Lavori\Clienti\" 'Path Source nomefo(4) = "C:\Lavori\ClientiNew" 'Path Destination nomefo(5) = "ESEMPIO.XLS" 'Archivio Esempio (struttura) nomefo(6) = Empty 'Nome Archivio Corrente nomefo(7) = Empty 'Nome Foglio corrente nomefo(8) = Empty nomefo(9) = Empty nomefo(10) = Empty 'range (rettangolo selezionato) tab_range(1, 1) = "$A$4:$N$" tab_range(2, 1) = "$Q$4:$Q$" tab_range(3, 1) = "$S$4:$T$" tab_range(4, 1) = "$AA$4:$AC$" tab_range(5, 1) = "$AG$4:$AH$" tab_range(6, 1) = "$AQ$4:$AQ$" tab_range(7, 1) = "$AW$4:$AZ$" ' tab_range(1, 2) = "$A$4" tab_range(2, 2) = "$Q$4" tab_range(3, 2) = "$S$4" tab_range(4, 2) = "$AA$4" tab_range(5, 2) = "$AG$4" tab_range(6, 2) = "$AQ$4" tab_range(7, 2) = "$AW$4" ' tab_mesi(1) = "Gen" tab_mesi(2) = "Feb" tab_mesi(3) = "Mar" tab_mesi(4) = "Apr" tab_mesi(5) = "Mag" tab_mesi(6) = "Giu" tab_mesi(7) = "Lug" tab_mesi(8) = "Ago" tab_mesi(9) = "Set" tab_mesi(10) = "Ott" tab_mesi(11) = "Nov" tab_mesi(12) = "Dic" ' ' Imposta il Ricalcolo Manuale With Application .Calculation = xlManual .MaxChange = 0.001 End With nrigacorr = 1 iswc = 0 papero1 = "" papero2 = "ESEMPIO.xls" MYPATH = nomefo(3) ' Imposta il percorso. nomefo(6) = Dir(MYPATH & "*.XLS", vbNormal) ' Recupera la prima voce. Do While nomefo(6) <> "" ' Avvia il ciclo. tt = 0 Select Case nomefo(6) Case papero1 iswc = 1 tt = 1 Case papero2 tt = 0 Case Else If iswc = 0 Then tt = 1 Else tt = 1 End If End Select If tt = 1 Then numscono = 0 Workbooks.Open Filename:=nomefo(3) & nomefo(5), UpdateLinks:=0 'Apre Esempio ' Workbooks.Open Filename:=nomefo(3) & nomefo(6), UpdateLinks:=0 'Apre clientexx.XLS (old Format) Windows(nomefo(6)).Activate Calculate n1 = Sheets.Count 'determina numero di fogli presenti i = 1 Do While i <= n1 Windows(nomefo(6)).Activate Sheets(i).Select Call foglio i = i + 1 Loop ' Application.DisplayAlerts = False Windows(nomefo(6)).Close savechanges:=False 'Chiude clientexxx.xls (old format) Call ordinafo Windows(nomefo(5)).Close savechanges:=True, Filename:=nomefo(4) & "\" & nomefo(6) Application.DisplayAlerts = True End If nomefo(6) = Dir ' Legge la voce successiva. Loop ' Calculate With Application .Calculation = xlAutomatic .MaxChange = 0.001 End With End Sub Sub foglio() ' nomefo(7) = Trim(ActiveSheet.Name) Select Case nomefo(7) Case Is = "Ord.", "ord.", "ord", "Ord", "Parametri" ' scarta il foglio Case Else maxblk = 20 numblk = 0 tab_valori(3) = 4 'Riga Corrente nel foglio Source tab_righe(1) = 0 'Prima riga Usata nel foglio source tab_righe(2) = 0 'ultima riga usata nel foglio source nofine = True Do While nofine If Cells(tab_valori(3), 3).Borders(xlEdgeBottom).LineStyle = xlContinuous And Cells(tab_valori(3), 3).Borders(xlEdgeBottom).Weight = xlThick Then nofine = False End If If Len(Cells(tab_valori(3), 3)) < 3 And Len(Cells(tab_valori(3), 6)) < 4 Then numblk = numblk + 1 If numblk > maxblk Then nofine = False End If Else If tab_righe(1) = 0 Then tab_righe(1) = tab_valori(3) End If tab_righe(2) = tab_valori(3) numblk = 0 End If tab_valori(3) = tab_valori(3) + 1 Loop ' tab_valori(1) = Empty 'Data Foglio tab_valori(2) = Trim(Cells(1, 3)) 'Ragione Sociale tab_valori(4) = 0 'Indicatore di errore tab_valori(5) = Empty 'Nome foglio If IsDate(Cells(1, 17)) Then tab_valori(1) = CDate(Cells(1, 17)) End If ' errore = 0 aa = "$A$4:$AZ$" & tab_valori(3) On Error GoTo pippo papero = range(aa).SpecialCells(xlCellTypeFormulas, 16).Select On Error GoTo 0 If errore = 0 Then Call modisource End If ' If nomefo(7) = "Vari" Then J = 1 Do While J < 8 zonadati = tab_range(J, 1) & tab_valori(3) Call copiazona(zonadati, tab_range(J, 2)) J = J + 1 Loop Rows(tab_valori(3) + 1 & ":500").Delete Call completa_VARI Else If Not IsEmpty(tab_valori(1)) And IsDate(tab_valori(1)) Then b1 = Month(tab_valori(1)) b2 = Year(tab_valori(1)) tab_valori(5) = tab_mesi(b1) & Right(Format(b2, "0000"), 2) Else numscono = numscono + 1 tab_valori(5) = "TMP" & Format(numscono, "000") End If Call creafoglio zonadati = "$A$4:$AZ$" & tab_valori(3) Call copiazona(zonadati, "$A$4") End If End Select Exit Sub ' pippo: errore = 1 Resume Next End Sub Sub copiazona(a1, a2) ' Windows(nomefo(6)).Activate 'Archivio Source Sheets(nomefo(7)).Select 'Foglio source range(a1).Select Selection.Copy ' Windows(nomefo(5)).Activate 'Archivio Destination If nomefo(7) = "Vari" Then Sheets("Vari").Select 'Foglio Destination Else Sheets(tab_valori(5)).Select End If range(a2).Select On Error GoTo pippo Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False On Error GoTo 0 If Not nomefo(7) = "Vari" Then Sheets("Vari").range("$A$1:$AZ$3").Copy range("$A$1").PasteSpecial Cells(1, 17) = tab_valori(1) End If Exit Sub ' pippo: Windows(nomefo(2)).Activate Sheets("Parametri").Cells(nrigacorr, 1) = nomefo(6) Windows(nomefo(2)).Activate Sheets("Parametri").Cells(nrigacorr, 2) = nomefo(7) nrigacorr = nrigacorr + 1 Windows(nomefo(5)).Activate 'Archivio Destination If nomefo(7) = "Vari" Then Sheets("Vari").Select 'Foglio Destination Else Sheets(tab_valori(5)).Select End If Resume Next End Sub Sub creafoglio() ' Windows(nomefo(5)).Activate 'Archivio Destination On Error GoTo creafo tab_valori(4) = 10 Sheets(tab_valori(5)).Select On Error GoTo 0 Exit Sub ' creafo: If Err.Number = 9 Then 'Errore=9 ==> foglio inesistente Sheets.Add after:=Worksheets(Worksheets.Count) Sheets(Sheets.Count).Name = tab_valori(5) Sheets(tab_valori(5)).Move after:=Sheets("Vari") tab_valori(4) = 0 Resume End If End Sub Sub ordinafo() ' questa sub ordina i fogli con NOME=DATA in ordine decrescente Windows(nomefo(5)).Activate k = 0 n1 = Sheets.Count i = 1 Do While i <= n1 nomefo(7) = Trim(Sheets(i).Name) aa = "01-" & Left(nomefo(7), 3) & "-" & Right(nomefo(7), 2) If IsDate(aa) Then k = k + 1 tab_nomi(k, 1) = nomefo(7) tab_nomi(k, 2) = Format(CDate(aa), "DD-MM-YYYY") End If i = i + 1 Loop ' Windows(nomefo(2)).Activate Sheets("Appoggio").Select 'Vuota il foglio appoggio range("$A$2:$Z$2000").Select Selection.ClearContents J = 2 Do While J <= k + 1 Cells(J, 1) = tab_nomi(J - 1, 1) Cells(J, 2) = tab_nomi(J - 1, 2) J = J + 1 Loop bb = "$A$1:$B$" & k + 1 range(bb).Select Selection.Sort key1:=range("B1"), order1:=xlDescending, header:=xlYes J = 2 Do While J <= k + 1 tab_nomi(J - 1, 1) = Cells(J, 1) J = J + 1 Loop Windows(nomefo(5)).Activate J = 1 Do While J <= k If J = 1 Then bb = "Vari" Else bb = tab_nomi(J - 1, 1) End If Sheets(tab_nomi(J, 1)).Move after:=Sheets(bb) J = J + 1 Loop ' End Sub Sub completa_VARI() ' ' tab_valori(1)= data presente nel foglio ' tab_valori(2)= Ragione sociale presente ' tab_valori(3)= numero assoluto dell'ultima riga ' Cells(1, 3) = tab_valori(2) 'Ragione Sociale If Not IsEmpty(tab_valori(1)) Then Cells(1, 17) = tab_valori(1) End If zonaN = "$A$4:$AZ$" & tab_valori(3) range(zonaN).Select With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThick .ColorIndex = xlAutomatic End With ' tab_nomi(1, 1) = "$AS$4" tab_nomi(1, 2) = "$AU$4" Windows(nomefo(6)).Activate 'archivio originale Sheets("Vari").Select jj = 1 Do While jj < 3 k = 4 jk = 0 n1 = range(tab_nomi(1, jj)).Column n2 = range("$AZ$1").Column Do While k <= tab_valori(3) If IsNumeric(Cells(k, n1)) Then If Not Cells(k, n1) = 0 Then If Not Cells(k, n1).HasFormula Then jk = jk + 1 tab_bb(jk, 1) = Cells(k, n1) tab_bb(jk, 2) = k End If End If Else If Len(Cells(k, n1)) > 0 Then jk = jk + 1 tab_bb(jk, 1) = Cells(k, n1) tab_bb(jk, 2) = k End If End If k = k + 1 Loop If jk > 0 Then Windows(nomefo(5)).Activate Sheets("Vari").Select kzkz = 1 Do While kzkz <= jk If IsNumeric(tab_bb(kzkz, 1)) Then Cells(tab_bb(kzkz, 2), n1) = tab_bb(kzkz, 1) Else Cells(tab_bb(kzkz, 2), n2) = tab_bb(kzkz, 1) End If kzkz = kzkz + 1 Loop Windows(nomefo(6)).Activate 'Archivio nuovo Sheets("Vari").Select End If jj = jj + 1 Loop End Sub Sub modisource(ccc As range) Dim c As range For Each c In ccc If Not IsNumeric(Cell.Value) Then Cells.AddComment Cells.Comment.Visible = False Cells.Comment.Text Text:=Cell.Value Cell.Value = Null Next End Sub A me è stato chiesto di sviluppare la sub modisource, in modo che il programma sia il più funzionale possibile (e cioè che cicli meno volte possibile per correggere gli eventuali errori). Noterai che la sub che chiama modisource contiene un metodo speciale che cerca solo le celle contenenti formule che vanno in errore (almeno, la spiegazione che excel mi dà è questa -_-), io pensavo che il modo più "rapido" per correggerle fosse il seguente. Partendo dalla cella con formula in errore io ciclo le celle contenute in certe colonne di quella riga, così che vengano corrette... mi sembra intelligente no? E cmq ho codificato un pezzo, ma poi non sò come recuperare la riga, infatti se lo faccio partire così mi corregge solo le celle con le formule, che io non voglio toccare. Spero di essere stato chiaro! |
![]() |
![]() |
![]() |
#19 | |
Senior Member
Iscritto dal: Dec 2004
Messaggi: 3208
|
Quote:
![]() Se un cliente mi chiedesse di verificargli una cosa simile e correggerla, assolutamente non lo farei gratis ! Detto questo, non ho capito perchè nella tua routine "modisource" dichiari un oggetto c per poi non usarlo mai... Prova intanto a sostituirla con questa : Codice:
Sub modisource(ccc As Range) Dim c As Range For Each c In ccc If Not IsNumeric(c.Value) Then c.AddComment c.Comment.Visible = False c.Comment.Text Text:=c.Value c.Value = Null End If Next End Sub Fammi sapere... ![]() |
|
![]() |
![]() |
![]() |
#20 |
Member
Iscritto dal: Jan 2006
Messaggi: 225
|
PRovo entro il pomeriggio
![]() Se fossi un privato ti darei assolutamente ragione, è un extra che mi hanno "chiesto" al lavoro, e dato che stò cercando una promozione diciamo che non ho troppa scelta ![]() Che non è chiaro e leggibile purtroppo lo sò ![]() Sulla storia dei cicli io ho fatto un certo tipo di ragionamento. Io ho studiato la programmazione orientata ad oggetti, quindi per me l'ideale è creare un programma formato da sottoalgoritmi da riutilizzare via via, che sono più comodi da scrivere, più facili da consultare, e snelliscono la codifica del programma finale. Ho ragionato sul fatto che io controllerei le varie colonne d'interesse in modo da evitare l'eventuale formazione di errori, e non dopo. Il mio capo invece preferisce che partendo dalla cella contenente una formula in errore si correggano le celle della colonna della riga in questione.. |
![]() |
![]() |
![]() |
Strumenti | |
|
|
Tutti gli orari sono GMT +1. Ora sono le: 14:42.