Forum di Excel e VBA, per condividere esperienze e risolvere problemi su:
Excel, Word, Access, Power Point, Microsoft Office, macro, Visual Basic e Visual Studio.

MACRO MESI



  • MACRO MESI
    di ANDREA (utente non iscritto) data: 27/03/2014 15:02:48

    RAGAZZI NON SONO BUONO A USARE VBS...avrei bisogno di una macro che mi dice a viedo : su quale colonna vuoi far partire la macro?

    A questo punto la macro IN QUELLA COLONNA mi deve fare questa sostituzione:
    se nella cella della colonna trova JAN mi mette GEN es (20-JAN-2012--> deve diventare 20-GEN-2012) e così via,
    se trova FEB mette FEB
    se trova MAR mette MAR
    se trova APR mette APR
    se trova MAY mette MAG
    se trova JUN mette GIU
    se trova JUL mette LUG
    se trova AUG mette AGO
    se trova SEP mette SET
    se trova OCT mette OTT
    se trova NOV mette NOV
    se trova DEC mette DIC


    Potete aiutarmi? Serve per iol mio capo, non sono buono, vi prego sono uno stagista non posso far brutta figura?

    Grazie mille a chiunque vorrà e proverà a aiutarmi.



  • di totygno71 data: 27/03/2014 15:31:04

    Caro Andrea
    in un primo non voglio fare il moralizzatore.... ma se non sei proprio capace di itulizzare vba fai prima a dirlo al tuo capo... una soluzione pronta non ti salverebbe affatto dal fare brutte figure in futuro.
    se invece hai bisogno solo di qualche spunto la cosa è diversa... e qui trovare tante persone pronte ad aiutarti....
    Pensaci....
    ciao Toty



  • di lepat (utente non iscritto) data: 27/03/2014 16:11:56

    prova questa macro
     
    Sub a()
colonna = InputBox("quale colonna (lettera)")
LR = Cells(Rows.Count, colonna).End(xlUp).Row
For r = 2 To LR
  d = Left(Cells(r, "J").Text, 11)
  x = Split(d, "-")
  d = DateValue(x(0) & "/" & conversione(x(1)) & "/" & x(2))
  Stop
  Cells(r, colonna) = d
Next
End Sub

Function conversione(d As Variant) As Byte
Dim mesi() As Variant, i As Byte
mesi = Array("JAN", "FEB", "MAR", "APR", "MAY", "JUN", _
"JUL", "AUG", "SEP", "OCT", "NOV", "DEC")
For i = 1 To 12
If mesi(i - 1) = UCase(d) Then
conversione = i
Exit Function
End If
Next
End Function



  • di Grograman (utente non iscritto) data: 27/03/2014 16:13:38

    Scusa, ma hai aperto 3 post con lo stesso file e la domanda posta in modi diversi.
    Una volta è convertire da testo a data, poi un replace, poi un formato data.

    Direi che modo migliore per non ottenere risposta credo non ce ne sia!



  • di Andrea (utente non iscritto) data: 27/03/2014 16:20:07

    Ciao , per prima cosa hai ragione, so che sicuramente il tuo consiglio è validissimo ma capisci bene che mi ha chiesto un piacere, lo sa che non lo conosco, faccio un lavoro del tutto diverso, ma lo sai gli stagisti li sfruttano e penso che questo sia anche un metodo per vedere se sono in grado di "attaccare" un problema diverso dal mio lavoro quotidiano, una sfida via.

    Se puoi aiutarmi per me sarebbe molto importante..



    Allora ho provato a lanciare la macro ma mi da errore si ferma alla scritta STOP.

    come mai?
    grazie e scusa per tutto il disturbo



  • di lepat (utente non iscritto) data: 27/03/2014 16:40:22

    elimina lo stop



  • di Andrea (utente non iscritto) data: 27/03/2014 16:41:23

    Allora usando il file che avevo postato togliendo la scritta Stop funziona.......
    Io però ho usato il file originale che ora allego, perchè con questo mi da errore, ho provato a analizzare la macro ma non riesco a capire dove può essere il problema? qualcuno può darmi una mano?

    Grazie e scusate ancora .




  • di Andrea (utente non iscritto) data: 27/03/2014 16:43:37

    Lancio la macro, mi chiede la colonna , tutto ok e poi mi da errore già qui:

    d = DateValue(x(0) & "/" & conversione(x(1)) & "/" & x(2))



  • di Andrea (utente non iscritto) data: 27/03/2014 16:45:15

    scusate il file che ho caricato non funzionava ,ho caricato quello giusto...scusate



  • di Andrea (utente non iscritto) data: 27/03/2014 16:58:37

    Allora ho trovato il problema , ma non so come risolverlo nella MACRO

    -ho dei valori scritti così : 16/07/2014 oltre a quelli che deve convertire, quindi quando trova quelli fa confusione...COME POSSO FARE A LIVELLO macro PER RISOLVERE IL PROBLEMA?



  • di lepat (utente non iscritto) data: 27/03/2014 22:37:13

    prova questa
     
    Sub a()
colonna = InputBox("quale colonna (lettera)")
LR = Cells(Rows.Count, colonna).End(xlUp).Row
For r = 2 To LR
  d = Left(Cells(r, colonna).Text, 11)
  If InStr(d, "-") > 0 Then
    x = Split(d, "-")
    d = DateValue(x(0) & "/" & conversione(x(1)) & "/" & x(2))
    Cells(r, colonna) = d
  End If
Next
End Sub

Function conversione(d As Variant) As Byte
Dim mesi() As Variant, i As Byte
mesi = Array("JAN", "FEB", "MAR", "APR", "MAY", "JUN", _
"JUL", "AUG", "SEP", "OCT", "NOV", "DEC")
For i = 1 To 12
If mesi(i - 1) = UCase(d) Then
conversione = i
Exit Function
End If
Next
End Function



  • di Mister_x (utente non iscritto) data: 28/03/2014 00:45:44

    ciao
    ti posto una sub() da mettere nel foglio
    questa riporta le date con i mesi in italiano, ma questi non sono calcolabili come date perche' sono semplicemente stringhe di testo
    il problema e' dovuto al fatto che tu in colonna ai sia date che stringhe
    ora la conversione la fa solo alle date perche' non ai detto se servono anche gli orari in questa procedura , visto tanto che molti sono ad orario 0

    ciao

     
    Option Explicit
Sub ConvertiData()
Dim Colonna As String
Dim i As Long
Dim DataCella As Variant
Dim DataSTR As String
On Error Resume Next
Colonna = InputBox("quale Colonna da trattare(lettera)")
With Application
For i = 2 To Cells(Rows.Count, Colonna).End(xlUp).Row
  If IsDate(Cells(i, Colonna)) Then
    DataCella = Cells(i, Colonna)
    Cells(i, Colonna).NumberFormat = "@"
    Cells(i, Colonna) = MeseIt(UCase(.Text(DataCella, "dd-mmm-yyyy")))
  Else
    Cells(i, Colonna).NumberFormat = "@"
    DataSTR = UCase(.Text(Mid(Cells(i, Colonna), 1, 11), "dd-mmm-yyyy"))
    Cells(i, Colonna) = MeseIt(DataSTR)
  End If
Next i
End With
End Sub

Function MeseIt(stringa As String)
Dim Variazione As String
Variazione = stringa
With Application
Variazione = .Substitute(Variazione, "JAN", "GEN")
Variazione = .Substitute(Variazione, "MAY", "MAG")
Variazione = .Substitute(Variazione, "JUN", "GIU")
Variazione = .Substitute(Variazione, "JUL", "LUG")
Variazione = .Substitute(Variazione, "AUG", "AGO")
Variazione = .Substitute(Variazione, "SEP", "SET")
Variazione = .Substitute(Variazione, "OCT", "OTT")
Variazione = .Substitute(Variazione, "DEC", "DIC")
End With
MeseIt = Variazione
End Function






  • di MIster_x (utente non iscritto) data: 28/03/2014 09:38:57

    ciao

    nel file postato ho inserito sia la sub() senza orario che con orario sta a te scegliere quale adattare al tuo caso

    ciao
     
    Option Explicit
Sub ConvertiData()
Dim Colonna As String
Dim i As Long
Dim DataCella As Variant
Dim DataSTR As String
On Error Resume Next
Colonna = InputBox("quale Colonna da trattare(lettera)")
With Application
For i = 2 To Cells(Rows.Count, Colonna).End(xlUp).Row
  If IsDate(Cells(i, Colonna)) Then
    DataCella = Cells(i, Colonna)
    Cells(i, Colonna).NumberFormat = "@"
    Cells(i, Colonna) = MeseIt(UCase(.Text(DataCella, "dd-mmm-yyyy")))
  Else
    Cells(i, Colonna).NumberFormat = "@"
    DataSTR = UCase(.Text(Mid(Cells(i, Colonna), 1, 11), "dd-mmm-yyyy"))
    Cells(i, Colonna) = MeseIt(DataSTR)
  End If
Next i
End With
End Sub
''
Function MeseIt(stringa As String)
Dim Variazione As String
Variazione = stringa
With Application
Variazione = .Substitute(Variazione, "JAN", "GEN")
Variazione = .Substitute(Variazione, "MAY", "MAG")
Variazione = .Substitute(Variazione, "JUN", "GIU")
Variazione = .Substitute(Variazione, "JUL", "LUG")
Variazione = .Substitute(Variazione, "AUG", "AGO")
Variazione = .Substitute(Variazione, "SEP", "SET")
Variazione = .Substitute(Variazione, "OCT", "OTT")
Variazione = .Substitute(Variazione, "DEC", "DIC")
End With
MeseIt = Variazione
End Function
''
Sub ConvertiData_e_Ora()
Dim Colonna As String
Dim i As Long
Dim DataCella As Variant
Dim DataSTR As String
On Error Resume Next
Colonna = InputBox("quale Colonna da trattare(lettera)")
With Application
For i = 2 To Cells(Rows.Count, Colonna).End(xlUp).Row
  If IsDate(Cells(i, Colonna)) Then
    DataCella = Cells(i, Colonna)
    Cells(i, Colonna).NumberFormat = "@"
    Cells(i, Colonna) = MeseIt(UCase(.Text(DataCella, "dd-mmm-yyyy hh:mm:ss")))
  Else
    Cells(i, Colonna).NumberFormat = "@"
    DataSTR = UCase(Cells(i, Colonna).Value)
    Cells(i, Colonna) = MeseIt(DataSTR)
  End If
Next i
End With
End Sub






  • di andrea (utente non iscritto) data: 01/04/2014 09:12:29

    sei un geniooooooooooooooooooooooo...grazie mille :)



  • di andrea (utente non iscritto) data: 01/04/2014 12:22:52

    Un ultimo piacere, se volevo che la conversione me la faceva in automatico quando lanciavo la macro senza specificare la cella, come cambiava la mia macro? Perchè avendo più campi data da sistemare farlo in automatico per tutti è la scelta migliore.

    Se mi puoi dare quest ultima mano te ne sono grato guarda, sei stato un grande :)



  • di Mister_x (utente non iscritto) data: 01/04/2014 13:22:05

    ciao andrea

    le sub() in questione sono cosi modificate per il cambio sulle colonne interessate
    rimane sempre che io ho preso in considerazione quelle che tu ai postato nel file

    "J N S U V W X AC" se per caso ce ne solo altre o qualcuna non serve basta che inserisci o togli , e' indiffrente la sequenza puoi anche misciarle basta che lasci uno spazio tra un elenco di colonna e l'altro
    la sub() che ai utilizzato non so quale sia, comunque la modifica te lo fatta su tutte e due

    ciao
     
    Option Explicit
Sub ConvertiData()
Dim Colonne As String
Dim Colonna As Variant
Dim i As Long
Dim DataCella As Variant
Dim DataSTR As String
On Error Resume Next
''Colonna = InputBox("quale Colonna da trattare(lettera)")
Colonne = "J N S U V W X AC" ''qui le colonne da trattare inserire con spazi
With Application
 .EnableEvents = False
 .ScreenUpdating = False
For Each Colonna In Split(Colonne, " ", -1)
For i = 2 To Cells(Rows.Count, Colonna).End(xlUp).Row
  If IsDate(Cells(i, Colonna)) Then
    DataCella = Cells(i, Colonna)
    Cells(i, Colonna).NumberFormat = "@"
    Cells(i, Colonna) = MeseIt(UCase(.Text(DataCella, "dd-mmm-yyyy")))
  Else
    Cells(i, Colonna).NumberFormat = "@"
    DataSTR = UCase(.Text(Mid(Cells(i, Colonna), 1, 11), "dd-mmm-yyyy"))
    Cells(i, Colonna) = MeseIt(DataSTR)
  End If
Next i
Next
 .EnableEvents = True
 .ScreenUpdating = True
End With
End Sub

Function MeseIt(stringa As String)
Dim Variazione As String
Variazione = stringa
With Application
Variazione = .Substitute(Variazione, "JAN", "GEN")
Variazione = .Substitute(Variazione, "MAY", "MAG")
Variazione = .Substitute(Variazione, "JUN", "GIU")
Variazione = .Substitute(Variazione, "JUL", "LUG")
Variazione = .Substitute(Variazione, "AUG", "AGO")
Variazione = .Substitute(Variazione, "SEP", "SET")
Variazione = .Substitute(Variazione, "OCT", "OTT")
Variazione = .Substitute(Variazione, "DEC", "DIC")
End With
MeseIt = Variazione
End Function

Sub ConvertiData_e_Ora()
Dim Colonna As Variant
Dim Colonne As String
Dim i As Long
Dim DataCella As Variant
Dim DataSTR As String
On Error Resume Next
''Colonna = InputBox("quale Colonna da trattare(lettera)")
Colonne = "J N S U V W X AC" ''qui le colonne da trattare inserire con spazi
With Application
  .EnableEvents = False
  .ScreenUpdating = False

For Each Colonna In Split(Colonne, " ", -1)
For i = 2 To Cells(Rows.Count, Colonna).End(xlUp).Row
  If IsDate(Cells(i, Colonna)) Then
    DataCella = Cells(i, Colonna)
    Cells(i, Colonna).NumberFormat = "@"
    Cells(i, Colonna) = MeseIt(UCase(.Text(DataCella, "dd-mmm-yyyy hh:mm:ss")))
  Else
    Cells(i, Colonna).NumberFormat = "@"
    DataSTR = UCase(Cells(i, Colonna).Value)
    Cells(i, Colonna) = MeseIt(DataSTR)
  End If
Next i
Next
 .EnableEvents = True
 .ScreenUpdating = True
End With
End Sub






  • di andrea (utente non iscritto) data: 01/04/2014 16:52:08

    ok, però c'è un problema, quando lancio la macro , gira correttamente ma mi cancella il valore nella cella I2, come mai ? si può risolvere?

    Un altra cosa, ho registrato una macro con della formattazione e che mi crea una pivot table, come faccio a attaccarla sotto? questa è la macro che vorrei quando finisce quella che mi hai mandato partisse:

     
     subORACLE3()
'
    Columns("B:B").ColumnWidth = 14.29
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "RESCH IN /PULL IN"
    Range("C2").Select
       '
       '
       '
       '
       ' oracle4 Macro
'
    Columns("A:A").ColumnWidth = 12.43
    Columns("B:B").ColumnWidth = 12
    Columns("C:C").ColumnWidth = 14.29
    Columns("D:D").ColumnWidth = 13.14
    Rows("1:1").Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Selection.Font.Bold = True
    Range("V3").Select
    Columns("E:E").ColumnWidth = 12.71
    Columns("E:E").ColumnWidth = 15
    Columns("F:F").ColumnWidth = 11.86
    Columns("E:E").ColumnWidth = 26.86
    Columns("E:E").ColumnWidth = 22
    Columns("E:E").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("F:F").Select
    Columns("G:G").ColumnWidth = 8.86
    Columns("G:G").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("H:H").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("I:I").Select
    Selection.ColumnWidth = 14.43
    Columns("J:J").Select
    Selection.ColumnWidth = 17.57
    Columns("J:J").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("K:K").Select
    Selection.ColumnWidth = 12.29
    Columns("L:L").ColumnWidth = 12
    Columns("L:L").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("K:K").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("M:M").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.ColumnWidth = 11.29
    Selection.ColumnWidth = 14.57
    Columns("L:L").Select
    Selection.ColumnWidth = 17.29
    Columns("N:N").Select
    Selection.ColumnWidth = 12.57
    Selection.ColumnWidth = 14.14
    Selection.ColumnWidth = 15.57
    Columns("N:N").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("Q:Q").Select
    Selection.ColumnWidth = 10.86
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("P:P").Select
    Selection.ColumnWidth = 11.43
    Selection.ColumnWidth = 13
    Selection.ColumnWidth = 13.71
    Cells.Select
    Range("I1").Activate
    With Selection.Font
        .Name = "Calibri"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    With Selection.Font
        .Name = "Calibri"
        .Size = 9
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Range("O6").Select
    Columns("O:O").ColumnWidth = 11
    Range("AA7").Select
    Columns("V:V").ColumnWidth = 14.29
    Columns("W:W").ColumnWidth = 16.86
    Columns("N:W").Select
    Range("W1").Activate
    With Selection
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("AA:AC").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("Z4").Select
    Columns("AB:AB").ColumnWidth = 12.86
    Columns("AB:AB").ColumnWidth = 13.43
    ActiveWindow.SmallScroll Down:=-24
    Range("A1:AQ1").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A1:AQ1").Select
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Columns("U:U").Select
    Selection.ColumnWidth = 15.57
    Selection.ColumnWidth = 17.14
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Columns("U:U").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("T1").Select
    Selection.Copy
    Range("U1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("T4").Select
    Columns("T:T").ColumnWidth = 11.57
    Columns("T:T").ColumnWidth = 12
    Range("S1").Select
    Columns("S:S").ColumnWidth = 14.57
    Columns("R:R").ColumnWidth = 11.86
    Range("P6").Select
    '
    ' oracle5 Macro
'
'
    Columns("D:E").Select
    Selection.Delete Shift:=xlToLeft
    Selection.ColumnWidth = 28.14
    Selection.ColumnWidth = 26.71
    Range("E11").Select
    Columns("E:E").ColumnWidth = 20.43
    Columns("C:C").Select
    Selection.Font.Bold = False
    Selection.Font.Italic = True
    Selection.Font.Bold = True
    Columns("C:C").Select
    Selection.Font.Bold = False
    Range("C1").Select
    Selection.Font.Bold = True
    Range("C4").Select
    Columns("I:I").ColumnWidth = 16
    Columns("I:I").ColumnWidth = 17.71
    Columns("H:H").Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("G1").Select
    Selection.Copy
    Range("H1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Rows("1:1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("I:I").Select
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("H1").Select
    Selection.Copy
    Range("I1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("S:S").Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("R1").Select
    Selection.Copy
    Range("S1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("S6").Select
    Columns("R:R").ColumnWidth = 15.29
    Columns("M:M").ColumnWidth = 13.86
    Columns("M:M").ColumnWidth = 17.14
    Columns("R:R").ColumnWidth = 17.14
    Cells.Select
    Range("J1").Activate
    With Selection.Font
        .Name = "Calibri"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Columns("P:P").Select
    Columns("O:O").ColumnWidth = 13.14
    Columns("O:O").ColumnWidth = 14.86
    Range("Y6").Select
    Columns("R:R").ColumnWidth = 18.43
    Columns("S:S").ColumnWidth = 18.29
    Columns("T:T").ColumnWidth = 16.43
    Columns("U:U").ColumnWidth = 18.71
    Columns("V:V").ColumnWidth = 16
    Columns("W:W").ColumnWidth = 10.86
    Columns("V:V").Select
    With Selection
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("AB:AB").Select
    With Selection
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("T:T").Select
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("S1").Select
    Selection.Copy
    Range("T1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("S7").Select
    '
    ' oracle6 Macro
'
'
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range("C2").Select
    '
    '
    '
    '
    '
    ' oracle8 Macro
'
'
    Range("C2").Select
    ActiveCell.FormulaR1C1 = _
        "=CONCATENATE(IF(AND(RC[6]7),""RESCH IN"",(IF(AND(RC[15]>RC[6],(RC[15]-RC[6])>7),""PULL IN"",""-""))),"" "",(IF(AND(RC[17]7),""   &PUSH OUT"")))"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = _
        "=CONCATENATE(IF(AND(RC[6]7),""RESCH IN"",(IF(AND(RC[15]>RC[6],(RC[15]-RC[6])>7),""PULL IN"",""-""))),"" "",(IF(AND(RC[17]7),""   &PUSH OUT"","""")))"
    Range("C3").Select
    '
    '
    '
    '
    '
    '
    '
    '
    '
' andr1 Macro
'
'
    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Supply Demand Resc In PO P_Pac !R1C1:R1048576C36", Version:= _
        xlPivotTableVersion14).CreatePivotTable TableDestination:="Sheet1!R1C1", _
        TableName:="PivotTable17", DefaultVersion:=xlPivotTableVersion14
    Sheets("Sheet1").Select
    Cells(1, 1).Select
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SetSourceData Source:=Range("Sheet1!$A$1:$C$18")
    ActiveSheet.Shapes("Chart 1").IncrementLeft 192
    ActiveSheet.Shapes("Chart 1").IncrementTop 15
    With ActiveSheet.PivotTables("PivotTable17").PivotFields("Source Supplier")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable17").PivotFields("RESCH IN /PULL IN")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable17").AddDataField ActiveSheet.PivotTables( _
        "PivotTable17").PivotFields("RESCH IN /PULL IN"), "Count of RESCH IN /PULL IN" _
        , xlCount
    Range("F23").Select
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "GRAFICO"
    Range("H22").Select
    '
    '
    '
    '
    '
    ' formattazione condizionale+aggiustamento pivot table, se troppo lenta eliminare
'
'
    Columns("B:B").ColumnWidth = 11.86
    Rows("1:1").RowHeight = 30.75
    Range("B1").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A1:B1").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Rows("1:1").RowHeight = 38.25
    With Selection.Font
        .Name = "Calibri"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Cells.Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Selection.RowHeight = 15
    Range("E6").Select
    Rows("1:1").RowHeight = 24
    Range("F9").Select
    Columns("B:B").ColumnWidth = 8.71
    Columns("B:B").ColumnWidth = 9.57
    Rows("1:1").RowHeight = 31.5
    Columns("A:A").ColumnWidth = 41.71
    Sheets("Supply Demand Resc In PO P_Pac ").Select
    Range("C2").Select
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
        Formula1:="=""RESCH IN """
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
End Sub



  • di andrea (utente non iscritto) data: 01/04/2014 16:54:07

    anche se la macro che ho fatto è lunga non è finalizzata al meglio però funziona, ecco io la vorrei mettere subito dopo la tua, ho provato più volta ma mi da un errore, come faccio a farla partire ?

    Devo partire con : sub oracle3 ()? perchè se parto così non gira si ferma alla tua



  • di Mister_x (utente non iscritto) data: 01/04/2014 19:31:56

    ciao andrea

    non capisco il problema della colonna I:I e relativo alla cella I2 quando nella sub() non e' contemplato l'intervento su tale colonna vedi elenco inserito
    Colonne = "J N S U V W X AC"
    altra cosa, cose' quel pastrocchio che ai postato ??? cosa dovrebbe fare in quel caso con quella serie di With
    cosa modifica a tali colonne
    forse se spieghi veramente il tuo problema con cosa bisogna fare si puo' risolvere comodamente e integrare il tutto
    Quindi prova spiegare colonna per colonna cosa devi fare e cosa vuoi ottenere

    ciao

    PS la relazione scrivila su un file word e poi postala cosi che si possa stampare e averla sottomano , altra cosa i dati nel file postato sono esatti a quelli che ti vengono passati, si intende la struttura e la posizione di tali!!






  • di andrea (utente non iscritto) data: 02/04/2014 08:24:30

    Allora vorrei integrare alla fine della tua macro questa macro:
    -tra la colonna B e C voglio inseire una nuova colonna chiamata RESCH IN/PULL IN che mi calcola questa funzione per tutte le righe : =CONCATENATE(IF(AND(I27);"RESCH IN";(IF(AND(R2>I2;(R2-I2)>7);"PULL IN";"-")));" ";(IF(AND(T27);" &PUSH OUT";"")))
    a questo punto in un altro foglio voglio creare una pivot table che mi restituisce grafico e tabella con queste impostazioni:
    -colum labels: RESCH IN /PULL IN
    -ROW labels:Source supplier
    -Values: count of RESCh IN /PULL IN

    ora ti allego anche il file che mi viene restituito dopo che lancio la tua e la mia macro.

    Ah delle tue utilizzo la macro senza le ore, funziona perfettamente...con le ore non funziona bene, tanto a me serve senza ore....se mi dai una mano perchè così devo usare 2 macro invece io vorrei usarne solo una....grazie



  • di andrea (utente non iscritto) data: 02/04/2014 08:29:51

    Se non riesci a fare la macro, mal che vada mi puoi dire come posso fare a integrare la mia ?

    Grazie e scusa per l'incompetenza

    Andrea



  • di Andrea (utente non iscritto) data: 02/04/2014 09:21:34

    IMPORTANTE



    Ciao , ho testato la tua macro, c' è un problema, secondo me non riconosce i campi come data, infatti se prova a fare un if dicendogli per esempio: =(IF(AND(I37);"RESCH IN";"0")) mi restituisce 0, anche se è esattemente il contrario..se cancello i dati e li metto a mano mi da resch in come è giusto che sia......come possiamo risolvere il problema ? questo è il problema più grave altrimenti non funziona niente...risp appena puoi =(=(=(=(=(=(



  • di andrea (utente non iscritto) data: 02/04/2014 09:28:57

    Scusa, è questo l'if
    si era copiato male...


    io non riesco a risolvere il problema.....pensavo funzionava invece non va =(
     
    =(IF(AND(I37);"RESCH IN";"0"))



  • di Mister_x (utente non iscritto) data: 02/04/2014 12:28:42

    ciao andrea

    visto il tuo ultimo post.
    diciamo apertamente che non capisco cosa vuoi fare con quei dati che ti vengono passati
    in partenza volevi modificare le date sia vere che false in dicitura italiano maiuscolo , e come ti avevo accennato queste erano stringhe e non date da poter calcolare
    dopo inserisci una colonna alla quale aggiungi funzioni Concatena() ecc.
    nel concatena troviamo un IF() con inserito AND() dove in AND(I37); ma dopo I37 cosa bisogna fare AND(I37 = o altro a che cosa) per far si che ritorni o true o false per eseguire IF()

    detto questo ti consiglio di spiegare cosa vuoi fare ai qiuei dati che importi in foglio1 e arrivare a mettere a posto tutto questo foglio, dopo di che puoi crearti la pivot in foglio2 e elaborare la mole di dati del foglio1,
    MA se questi non e' a posto strutturamente e completo avrai sempre errori di riporto a tutto

    a mio parere prova a esporre ,ricordandoti la bella matematica di 4 o 5 elementare,PROBLEMA
    dato un certo x,y,z creare tutti i passaggi per arrivare al risultato, senza saltarne uno pensando che questo si sa
    quindi prova a scrivere questo come ti avevo consigliato di fare e passare a noi il tutto, onde poter eseguire con la sub i vari passaggi

    ciao




 


by Globosoft © 2018 Regole di utilizzo | Contatti | Privacy Policy