Popolamento Database tramite codice – Pagina 2

Stai vedendo 25 articoli - dal 26 a 50 (di 90 totali)

Autore

Articoli

04/04/2024 alle 9:22 #45354 Score: 0 | Risposta

Moderatore

Karma: 58 pts

Non ho capito bene...ma se questo codice già esiste, fai un nuovo inserimento di questo codice e in più aggiorna con questi nuovi dati tutti quelli uguali?

Mi spiego meglio:

Codice AA1100 già presente con tutti i sui dati. Provo ad inserire un altro codice AA1100...se scelgo SI alla richiesta di aggiornamento codice, lui mi inserisce un altro codice AA1100 (quindi ne avrò 2 uguali) e in più aggiorna i dati a quello/i precedente/i?

Oppure deve solo andare ad aggiornare i dati dei codici uguali? Quindi stesso discorso di prima ma anziché aggiungere un ulteriore codice uguale, va ad aggiornare quelli uguali già presenti?

04/04/2024 alle 9:32 #45355 Score: 0 | Risposta

Ale.1989

Partecipante

Ciao Alex, devo solo aggiornare i dati del codice già presente, non devono esserci codici doppi.

Lo faccio solo perché alcune celle del database che all'inizio rimangono vuote le andrei a popolare in un secondo momento.

04/04/2024 alle 9:52 #45356 Score: 0 | Risposta

alexps81

Moderatore

Karma: 58 pts

Quindi immagino che ci sarà sempre e solo un Codice con quel numero? Se così fosse prova questo che ti allego. Sostituisci la Sub InserisciDati presente nel Moulo1 con questa nuova:

Sub InserisciDati()
Dim wsMR As Worksheet, wsDt As Worksheet
Dim rngDt As Range, Trovato As Range
Dim urDt As Long
Dim Codice As Variant, K1 As Variant, K2 As Variant, LM As Variant
Dim i As Byte

Set wsMR = ThisWorkbook.Worksheets("MASCHERA RICERCA")
Set wsDt = ThisWorkbook.Worksheets("Database")

Codice = wsMR.Range("K7")

urDt = wsDt.Cells(Rows.Count, 1).End(xlUp).Row

Set rngDt = wsDt.Range("A2:A" & urDt)

Set Trovato = rngDt.Find(Codice, LookIn:=xlValues, LookAt:=xlWhole)

K1 = Array(11, 12, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23)
K2 = Array(24, 25, 26, 27, 29, 30, 31, 33, 34)
LM = Array(17, 18, 19, 20, 21, 22, 23)

If Not Trovato Is Nothing Then
    i = MsgBox("Il codice " & Codice & " è già presente nel foglio ""Database!""" & String(2, vbCrLf) & "Vuoi aggiornare il codice?", vbQuestion + vbYesNo, "Attenzione...")
    If i = vbNo Then Set wsMR = Nothing: Set wsDt = Nothing: Set Trovato = Nothing: Exit Sub
    
    wsDt.Cells(Trovato.Row, "AL") = wsMR.Range("G29")
    wsDt.Cells(Trovato.Row, "AK") = wsMR.Range("G31")
    wsDt.Cells(Trovato.Row, "AO") = wsMR.Range("H47")
    wsDt.Cells(Trovato.Row, "AM") = wsMR.Range("H34")
    wsDt.Cells(Trovato.Row, "AN") = wsMR.Range("H35")
    
    For i = LBound(K1) To UBound(K1)
        wsDt.Cells(Trovato.Row, i + 2) = wsMR.Range("K" & K1(i))
    Next i
    
    For i = LBound(K2) To UBound(K2)
        wsDt.Cells(Trovato.Row, i + 28) = wsMR.Range("K" & K2(i))
    Next i
    
    For i = LBound(LM) To UBound(LM)
        wsDt.Cells(Trovato.Row, i + 14) = wsMR.Range("L" & LM(i))
        wsDt.Cells(Trovato.Row, i + 21) = wsMR.Range("M" & LM(i))
    Next i
    
    MsgBox "Codice " & Codice & " aggiornato correttamente.", vbInformation, "Aggiornamento codice " & Codice
Else
    i = MsgBox("Vuoi inserire il codice " & Codice & " nel foglio ""Database?", vbQuestion + vbYesNo, "Inserimento nuovo codice")
    
    If i = vbNo Then Set wsMR = Nothing: Set wsDt = Nothing: Set Trovato = Nothing: Exit Sub
    
    
    wsDt.Cells(urDt + 1, "A") = Codice
    wsDt.Cells(urDt + 1, "AL") = wsMR.Range("G29")
    wsDt.Cells(urDt + 1, "AK") = wsMR.Range("G31")
    wsDt.Cells(urDt + 1, "AO") = wsMR.Range("H47")
    wsDt.Cells(urDt + 1, "AM") = wsMR.Range("H34")
    wsDt.Cells(urDt + 1, "AN") = wsMR.Range("H35")
    
    For i = LBound(K1) To UBound(K1)
        wsDt.Cells(urDt + 1, i + 2) = wsMR.Range("K" & K1(i))
    Next i
    
    For i = LBound(K2) To UBound(K2)
        wsDt.Cells(urDt + 1, i + 28) = wsMR.Range("K" & K2(i))
    Next i
    
    For i = LBound(LM) To UBound(LM)
        wsDt.Cells(urDt + 1, i + 14) = wsMR.Range("L" & LM(i))
        wsDt.Cells(urDt + 1, i + 21) = wsMR.Range("M" & LM(i))
    Next i
    
    MsgBox "Codice " & Codice & " inserito correttamente.", vbInformation, "Inserimento nuovo codice"
End If

Set wsMR = Nothing: Set wsDt = Nothing: Set Trovato = Nothing

End Sub

Altra cosa...nella cella K13 del foglio MASCHERA RICERCA ho trovato questa formula =_xlfn.CONCAT(K11;"X";K12) ma nella mia versione di Excel non funziona...magari è diversa dalla tua. Cmq per concatenare ti basta fare =K11 & "X" & K12

04/04/2024 alle 10:06 #45357 Score: 0 | Risposta

Ale.1989

Partecipante

Il codice funziona perfettamente, ho anche modificato la cella k13 io avevo inserito la formula per il concatena...

grazie mille

04/04/2024 alle 12:05 #45358 Score: 0 | Risposta

Ale.1989

Partecipante

Ciao Alex, ho un problema di calcolo in L16 E M 16 del foglio Calcolo Costi Auto vengono effettuate 2 operazioni il problema è che se in J7 scrivo manualmente il valore 1,35 il calcolo viene effettuato correttamente se lascio la stringa di codice per ricercare il valore automaticamente che mi restituisce sempre il valore 1,35 mi viene una differenza di 0,027 centesimi e non riesco a capire da dove provenga, ho controllato tutti gli arrotondamenti ma proprio non riesco a trovare il motivo.

Ci lavoro da 3 ore e non riesco a saltarci fuori......

Ti ho allegato il file direttamente sulla pagina incriminata

Allegati:

You must be logged in to view attached files.

04/04/2024 alle 13:36 #45360 Score: 0 | Risposta

Ale.1989

Partecipante

Ho già risolto, ho utilizzato la funziona tronca...

08/04/2024 alle 14:50 #45544 Score: 0 | Risposta

Ale.1989

Partecipante

Sono di nuovo in difficoltà, stavolta si tratta di una cosa apparentemente stupida.

In pratica una una semplice operazione di somma mi sta facendo dannare... sarà per qualche arrotondamento sbagliato che non trovo ma mi trovo sempre una differenza di 0,01€ nel totale, allego il filo sulla pagina incriminata.

Come si può vedere la cella p45 contiene un valore, in d46 è presente un altro valore ma se eseguo p45-d46 con la calcolatrice viene 22,15 mentre in m44 ( dove avviene questa operazione ) risulta 22,16

é un arrotondamento perché per altri codici il risultato mi viene coretto.

Alex se riesci ad aggiustarlo non so come ringraziarti,

Allegati:

You must be logged in to view attached files.

08/04/2024 alle 15:12 #45546 Score: 0 | Risposta

alexps81

Moderatore

Karma: 58 pts

Allora, io non sono bravo sulle formule...però da quello che vede in P45 il risultato della formula non da in realtà 26,93 ma 26,93450563 e nella cella D46 la formula non da 4,78 ma 4,7787. Tu le vedi così perché hai formattato le celle come NUMERO con posizione decimali a 2.

Ora mi sa che in questo modo i calcoli vengono riportati con un arrotondamento per eccesso. Quindi la reale differenza sarebbe 26,93450563-4,7787= 22,15580563...che arrotondato per eccesso ti fa vedere 22,16.

Due sono le strade: o aumenti il numero di posizioni decimali (tipo da 2 a 4) nella cella M43 così da avere 22,1558, oppure sempre in M43 metti =ARROTONDA.PER.DIF(P45-D46;2)

08/04/2024 alle 15:13 #45547 Score: 0 | Risposta

gianfranco55

Partecipante

Karma: 91 pts

ciao

26,9345056317867-4,7787

ha ragione excel

=ARROTONDA('Calcolo Costi Auto'!L16;2)

=ARROTONDA(M42+U46+X46+Y46+X47+X48+Y48+U47+(M42/100*U45);2)

ti rende come la calcolatrice

08/04/2024 alle 15:42 #45549 Score: 0 | Risposta

Ale.1989

Partecipante

grazie mille non ci avevo proprio pensato, avendo la visualizzazione a 2 decimali non ho controllato, c'è un metodo per vedere effettivamente con quali valori viene effettuata l'operazione?

08/04/2024 alle 15:48 #45550 Score: 0 | Risposta

gianfranco55

Partecipante

Karma: 91 pts

ciao

basta aumentare i decimali

08/04/2024 alle 16:58 #45551 Score: 0 | Risposta

Ale.1989

Partecipante

Ho risolto con la funzione arrotonda.

Ora devo popolare un foglio che si chiama SCHEDA TECNICA con una serie di valori presenti nel foglio MASCHERA RICERCA Avevo cominciato a scrivere il codice tramite copia e incolla, ma Alex mi diceva che il foglio diventa molto pesante e lento.

Potreste darmi il codice in questo formato?

Poi i vari abbinamenti delle celle li faccio io copiando la stringa e modificando le celle di riferimento

Grazie mille a tutti per le risposte

Sub InserisciDati()
Dim wsMR As Worksheet, wsDt As Worksheet
Dim rngDt As Range, Trovato As Range
Dim urDt As Long
Dim Codice As Variant, K1 As Variant, K2 As Variant, LM As Variant
Dim i As Byte

Set wsMR = ThisWorkbook.Worksheets("MASCHERA RICERCA")
Set wsDt = ThisWorkbook.Worksheets("Database")

Codice = wsMR.Range("K7")

urDt = wsDt.Cells(Rows.Count, 1).End(xlUp).Row

Set rngDt = wsDt.Range("A2:A" & urDt)

Set Trovato = rngDt.Find(Codice, LookIn:=xlValues, LookAt:=xlWhole)

K1 = Array(11, 12, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23)
K2 = Array(24, 25, 26, 27, 29, 30, 31, 33, 34)
LM = Array(17, 18, 19, 20, 21, 22, 23)

If Not Trovato Is Nothing Then
    i = MsgBox("Il codice " & Codice & " è già presente nel foglio ""Database!""" & String(2, vbCrLf) & "Vuoi aggiornare il codice?", vbQuestion + vbYesNo, "Attenzione...")
    If i = vbNo Then Set wsMR = Nothing: Set wsDt = Nothing: Set Trovato = Nothing: Exit Sub
    
    wsDt.Cells(Trovato.Row, "AL") = wsMR.Range("G29")
    wsDt.Cells(Trovato.Row, "AK") = wsMR.Range("G31")
    wsDt.Cells(Trovato.Row, "AO") = wsMR.Range("H47")

08/04/2024 alle 19:16 #45553 Score: 0 | Risposta

alexps81

Moderatore

Karma: 58 pts

Cosa intendi con:

Ale.1989 ha scritto:

Potreste darmi il codice in questo formato?

Poi per popolare potresti anche evitare di ricorrere al metodo Copy. Ti basta un semplice Foglio1.Range ("A1") = Foglio2.Range("B1")

Cmq prova essere più specifico...almeno io ho capito poco della tua richiesta.

09/04/2024 alle 8:25 #45556 Score: 0 | Risposta

Ale.1989

Partecipante

Ciao Alex il codice in questione è questo, ho registrato le prime 2 celle e funzionava poi ho copiato e incollato modificando i riferimenti alle celle ed ora non funziona più, volevo anche che prima di copiare e incollare le celle cancellasse il contenuto delle celle di destinazione in modo da non avere valori che sono rimasti dall'inserimento precedente.

Sto anche lavorando, cercando in rete un codice che mi permetta dopo aver popolato la scheda tecnica di esportarla in un nuovo file excel che abbia come nome il codice del prodotto.... salvato nella cartella in cui si trova il file originale

Sub PopolaScheda()
    Sheets("MASCHERA RICERCA").Select
    Range("K7").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("d2").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("K8").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("H2").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("G11").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("C8").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("G14").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("G8").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("K13").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("C10").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("K14").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("F10").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("K15").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("H10").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("K16").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("C12").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("G7").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("F12").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("G8").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("C14").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("G9").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("G14").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("G12").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("C20").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("G13").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("G20").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("K26").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("D22").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("G10").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("G22").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("D4").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("F26").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("D5").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("D27").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("D6").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("F27").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("D9").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("C30").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("D36").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("F30").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("D7").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("F29").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("D8").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("H29").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("D21").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("C31").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("D22").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("E31").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("D23").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("G31").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("D13").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("F34").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("X7").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("H34").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("D10").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("C35").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("D16").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("F35").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("D14").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("F37").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("D11").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("C38").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("D16").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("F38").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("D12").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("C41").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("D15").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("F40").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("D16").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("F41").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("D30").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("F43").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("D31").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("C44").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("D32").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("F44").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("D18").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("F46").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("D49").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("A47").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("D17").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("A50").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
        Sheets("MASCHERA RICERCA").Select
    Range("D20").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("A53").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
        Sheets("MASCHERA RICERCA").Select
    Range("D19").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("F52").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("D24").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("C56").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("D25").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("C57").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("D26").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("C58").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("F37").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("E56").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("G37").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("E57").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("H37").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("E58").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("H34").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("G56").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("H35").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("G57").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
    Sheets("MASCHERA RICERCA").Select
    Range("N49").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets("Scheda Tecnica").Select
    Range("C59").Select
    ActiveSheet.PasteSpecial Format:="Testo", Link:=False, DisplayAsIcon:= _
        False
End Sub

Allegati:

You must be logged in to view attached files.

09/04/2024 alle 14:15 #45565 Score: 0 | Risposta

alexps81

Moderatore

Karma: 58 pts

Mamma mia...povero progetto tuo!

Per ora prova questo:

Sub PopolaScheda()
Dim wsMR As Worksheet
Dim wsST As Worksheet
Dim vFieldsMR As Variant
Dim vFieldsST As Variant
Dim i As Byte

i = MsgBox("Vuoi copiare i dati nel foglio ""Scheda Tecnica?""", vbQuestion + vbYesNo, "Copia dati")
If i = vbNo Then Exit Sub

Set wsMR = ThisWorkbook.Worksheets("MASCHERA RICERCA")
Set wsST = ThisWorkbook.Worksheets("Scheda Tecnica")


wsMR.Activate
vFieldsMR = Array("K7", "K8", "G11", "G14", "K13", "K14", "K15", "K16", "G7", "G8", "G9", _
                  "G12", "G13", "K26", "G10", "D4", "D5", "D6", "D9", "D36", _
                  "D7", "D8", "D21", "D22", "D23", "D13", "X7", "D10", "D16", "D14", _
                  "D11", "D16", "D12", "D15", "D16", "D30", "D31", "D32", "D18", "D49", _
                  "D17", "D20", "D19", "D24", "D25", "D26", "F37", "G37", "H37", "H34", _
                  "H35", "N49")
wsST.Activate
vFieldsST = Array("D2", "H2", "C8", "G8", "C10", "F10", "H10", "C12", "F12", "C14", _
                 "G14", "C20", "G20", "D22", "G22", "F26", "D27", "F27", "C30", _
                 "F30", "F29", "H29", "C31", "E31", "G31", "F34", "H34", "C35", _
                 "F35", "F37", "C38", "F38", "C41", "F40", "F41", "F43", "C44", _
                 "F44", "F46", "A47", "A50", "A53", "F52", "C56", "C57", "C58", _
                 "E56", "E57", "E58", "G56", "G57", "C59")
                    
'Cancella tutti i campi nel foglio Scheda Tecnica
For i = LBound(vFieldsST) To UBound(vFieldsST)
    wsST.Range(vFieldsST(i)) = ""
Next i
                  
'Popola tutti i campi del foglio Scheda Tecnica prelevando i dati dal foglio Maschera Ricerca
For i = LBound(vFieldsMR) To UBound(vFieldsMR)
    wsST.Range(vFieldsST(i)) = wsMR.Range(vFieldsMR(i))
Next i
                  
MsgBox "Dati copiati", vbInformation, " Copia dati"

Set wsMR = Nothing: Set wsST = Nothing

End Sub

ho creato 2 Array (vFieldsMR e vFieldsST), rispettivamente che puntano alle celle che hai indicato tu dei due fogli. Poi attraverso 2 cicli, prima cancella il contenuto delle celle nel foglio Scheda Tecnica (sinceramente non so se serve così visto che cmq subito dopo vengono popolate dai nuovi dati...forse a te serve una Sub a parte che li cancella quando vuoi tu?), poi, come anticipato prima, vado a copiare il contenuto delle celle del foglio Maschera Ricerca nelle celle del foglio Scheda Tecnica.

Vedi se è corretto...caso mai devi cambiare/aggiungere/eliminare delle celle...vai nei due Array e metti i riferimenti delle celle che ti servono. Devi rispettare l'ordine delle celle tra il primo e il secondo array. Non puoi metterle nell'ordine che vuoi. Cioè se vuoi che la cella A1 del secondo foglio sia uguale alla cella C1 del primo foglio...allora il primo Array sarà:

vFieldMR = Array("C1", .....)

mentre il secondo....

vFieldsST = Array("A1", ....)

Per quanto riguarda l'esportazione...purtroppo posso vederlo stasera...per ora divertiti tu a trovare una soluzione.

09/04/2024 alle 17:32 #45577 Score: 0 | Risposta

Ale.1989

Partecipante

Ovviamente funziona alla grande .

On line non ho ancora trovato nessun codice per l'esportazione...

Per il momento lo faccio manualmente

09/04/2024 alle 18:51 #45579 Score: 0 | Risposta

alexps81

Moderatore

Karma: 58 pts

Ale.1989 ha scritto:

Per il momento lo faccio manualmente

Allora prova questo...subito dopo i 2 cicli...cancella dalla MsgBox "Dati copiati" in poi e inserisci questo...fammi sapere come va:

i = MsgBox("Dati copiati." & String(2, vbCrLf) & "Vuoi creare una copia della ""Scheda Tecnica?", vbQuestion + vbYesNo, " Copia dati")
If i = vbNo Then Set wsMR = Nothing: Set wsST = Nothing: Exit Sub

Call CreaCopia(Sheets("Scheda Tecnica").Name, Range("D2"))

Set wsMR = Nothing: Set wsST = Nothing

End Sub

Sub CreaCopia(ByVal sh As String, ByVal cella As Range)
Dim wbNew As Workbook
Dim ws As Worksheet
Dim NomeFile As String

Application.ScreenUpdating = False

Set ws = ThisWorkbook.Worksheets(sh)

ws.Copy

NomeFile = ThisWorkbook.Path & "\" & cella.Value & ".xlsx"

Set wbNew = Application.Workbooks.Item(Application.Workbooks.Count)

wbNew.SaveAs NomeFile
wbNew.Close False, NomeFile

Set wbNew = Nothing: Set ws = Nothing

Application.ScreenUpdating = True

End Sub

Ora io non so tu quando vuoi che parta la creazione del nuovo Workbook intitolato come il codice prodotto...quindi ho messo una MessageBox alla fine della copia che ti chiede se vuoi creare la copia oppure no. Inoltre questa Sub (parlo della creazione del nuovo Workbook [Sub CreaCopia]) te l'ho resa un po' dinamica, nel senso che se ti serve in altri punti del progetto la puoi richiamarla passandoci i valori del Nome del Foglio e il valore della cella da cui ricaverai il nome del Workbook.

Infatti se vedi con:

Call CreaCopia(Sheets("Scheda Tecnica").Name, Range("D2"))

inserisco il nome del foglio e il range dove prelevare il dato che darà il nome al Workbook.

10/04/2024 alle 7:51 #45596 Score: 0 | Risposta

Ale.1989

Partecipante

Ciao Alex funziona tutto alla perfezione tranne la creazione della nuova scheda, al momento quando premo si per creare la copia non succede nulla, mentre quando vado a chiudere il file "CALCOLO-ALGORITMO" si apre una nuova cartella di nome "cartel3" con all'interno il foglio copiato ma al momento non lo salva automaticamente, già così potrebbe andare bene solo che vorrei che si aprisse subito il nuovo file invece di dover chiudere il file.

Ti allego il file così se vuoi provare puoi farlo

Allegati:

You must be logged in to view attached files.

10/04/2024 alle 9:11 #45604 Score: 0 | Risposta

alexps81

Moderatore

Karma: 58 pts

Che strano...a me funziona senza problemi. Prova a commentare questa linea di codice e vediamo se soddisfa la tua richiesta:

'wbNew.Close False, NomeFile

Io avevo previsto che una volta creato il nuovo file, in automatico si chiudeva direttamente. Se invece lo vuoi vedere aperto (dopo creato), allora fai come descritto su. Fammi sapere.

10/04/2024 alle 9:26 #45605 Score: 0 | Risposta

Ale.1989

Partecipante

A me continua a fare così, quando chiudo il file si apre la cartella nominata cartel5 ti allego lo screen

Allegati:

You must be logged in to view attached files.

10/04/2024 alle 10:01 #45610 Score: 0 | Risposta

alexps81

Moderatore

Karma: 58 pts

Sbaglio o stai utilizzando la versione Excel per Mac? Forse c'è qualche problema con la Funzione SaveAs che salva il file. Che versione Excel utilizzi?

Apri una finestra immediata (fai CTRL + G nell'editor VBE) e scrivi:

?Val(Application.Version)

dai invio e vedi che numero esce

10/04/2024 alle 10:33 #45611 Score: 0 | Risposta

alexps81

Moderatore

Karma: 58 pts

Io purtroppo non conosco il Mac, sicuramente ci sono delle differenze. Mi sembra di leggere che tanto per cominciare il separatore nei percorsi non è il carattere "\" ma è "/"

Prova a modificare questa linea di codice e vedi se funziona:

NomeFile = ThisWorkbook.Path & "/" & cella.Value & ".xlsx"

Il problema è che se così funziona o lo fai girare sempre sul Mac oppure dobbiamo prevedere una variabile NomeFile alternativa se la versione Excel è di Windows

10/04/2024 alle 13:21 #45623 Score: 0 | Risposta

Ale.1989

Partecipante

Si io utilizzo Mac, la stringa che mi hai dato non funziona per capire la versione, ho visto dal menù che la versione installata è la 16.78.3 ma sinceramente non so quale sia, Comunque sia per il discorso salvataggio automatico posso anche farne a meno mi basta che si apra automaticamente il nuovo file, anzi forse è meglio così lo posso anche stampare direttamente senza dover aprirlo di nuovo...

10/04/2024 alle 13:27 #45625 Score: 0 | Risposta

alexps81

Moderatore

Karma: 58 pts

Ma giusto per info...hai provato a cambiare il separatore di percorso? Da "\" a "/"?

NomeFile = ThisWorkbook.Path & "/" & cella.Value & ".xlsx"

eventualmente prova anche:

NomeFile = ThisWorkbook.Path & Application.PathSeparator & cella.Value & ".xlsx"

10/04/2024 alle 13:46 #45626 Score: 0 | Risposta

Ale.1989

Partecipante

aggiornato stringa con la prima opzione ( modificando da "\" a "/" adesso il file creato ha il nome del codice in D2 quindi andiamo già bene, però il file appena creato non si apre subito si apre solamente quando chiudo la finestra principale...

Autore

Articoli

Stai vedendo 25 articoli - dal 26 a 50 (di 90 totali)

← 1 2 3 4 →