creare calendario visite

Hai un problema con Excel?

Nuova discussione

creare calendario visite
di sao (utente non iscritto) data: 16/10/2012 09:19:53
Scusate per il disturbo non sono un grande esperto di VBA e chiedo un aiuto.
Windows 7 e Office 2010
Devo creare un calendario visite per i venditori.
Per i clienti che vengono visitati più volte nell'arco della settimana io ho, attualmente estratta da un gestionale in excel, una tabella con righe del tipo:
Cliente-indirizzo-etc-7 colonne (1 per ogni girono della settimana) in cui se il cliente viene vistato appare una"S" mentre se non viene visitato appare una "N" quindi, ad esempio, per due clienti:

MARIO BIANCHI TORINO SNSNSNN
CLAUDIO NERI MILANO NNNSNNN

il primo cliente, quindi, viene visitato il lunedì, mercoledì e venerdì
mentre il secondo viene visitato solo il giovedì

A me servirebbe una macro la quale mi trasformi la situazione sopra in questa:
MARIO BIANCHI TORINO SNNNNNN
MARIO BIANCHI TORINO NNSNNNN
MARIO BIANCHI TORINO NNNNSNN
CLAUDIO NERI MILANO NNNSNNN

e cioè nel caso del primo cliente mi crei una riga per ogni altro giorno di visita (sotto vengono, quindi generate due righe una per il mercoledì ed una per il venerdì mantenendo la prima riga per il lunedì) mentre nel caso del secondo mantenga una riga sola (solo per il giovedì)
Chiaramente se un cliente, ipoteticamente, dovesse venir visitato ogni giorno della settimana (7 visite) la macro dovrebbe aggiungere 6 righe sotto (mantenendo quella esistente per il primo giorno di visita).
Spero di essere stato chiaro.
Se qualcuno mi potrà aiutare anticipatamente ringrazio.

LEGGI ANCHE: Creare Calendario in Excel
di Vecchio Frac data: 16/10/2012 09:59:49
Fai un tentativo con il registratore di macro per avere una base da cui partire (poi il codice prodotto va ovviamente scremato e ottimizzato, ma almeno ti dà l'idea delle istruzioni di base che puoi utilizzare). Ti sarà utile almeno per capire come impostare l'inserimento di una riga con copia e incolla degli stessi dati. Quindi: avvia una sessione di macro, copia una riga, inserisci riga nella riga sottostante, incolla, ferma il registratore, analizza il codice.
Poi si tratterà di esaminare la cella contenente la stringa "SN", scorrerla carattere per carattere e apportare le modifiche sostituendo le S fuori posto con una N.
Butta giù un'idea, anche in pseudocodice e poi la analizziamo insieme.
di sao (utente non iscritto) data: 16/10/2012 11:48:28
Io,per iniziare, avrei pensato di creare una colonna di appoggio L che mi conteggi le "S" presenti nella griglia dei giorni di visita.
Fatto questo, però, rimane da capire come potrei legare il numero di righe da creare sotto al numero di "S" (S-1) e, sopratutto, fare il copia-incolla dei testi presenti nella riga-campione ed elaborare i vari "S" e "N".
Per creare la nuova riga:
Sub prova() ' prova Macro ' ' Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Range("A1").Select End Sub

di Vecchio Frac data: 16/10/2012 16:15:19
Quesito non banale, mi accorgo, e comunque sei sulla strada buona.
Ti lascio questo primo pezzo di codice, che per il momento duplica le righe uguali.
Suppone che la tabella cominci da A1 dove si trova l'intestazione della stessa.
Il punto interessante è come ciclare nelle sette colonne giornaliere per (ad ogni passaggio) annullare le "S" non pertinenti.
Sto ovviamente cercando un codice ottimizzato, non ridondante ed efficiente ^_^

Sub test()
Dim r As Range, n As Integer, j As Integer, i As Integer, k As Integer

    j = [A1].CurrentRegion.Rows.Count
    For i = j To 2 Step -1
        Set r = Range(Cells(i, 1), Cells(i, 10))
        n = WorksheetFunction.CountIf(r.Resize(, 7).Offset(, 3), "S")
        
        For k = 1 To (n - 1)
            r.Offset(k).Insert Shift:=xlShiftDown
            r.Copy r.Offset(k)
        Next
    Next
End Sub

di Vecchio Frac data: 16/10/2012 17:11:40
Il codice che segue, lo ammetto, fa terribilmente schifo :)
Arzigogolato è dire poco... va testato un po' meglio anche se a me *sembra* funzionare.
Non sparate sul pianista :P

Option Explicit

Sub test()
Dim ac As Range, r As Range, n As Integer, j As Integer, i As Integer, k As Integer
Dim s As String, u As Integer, m As Integer, g As Integer, shrp As String

    j = [A1].CurrentRegion.Rows.Count
    For i = j To 2 Step -1
        Set r = Range(Cells(i, 1), Cells(i, 10))
        n = WorksheetFunction.CountIf(r.Resize(, 7).Offset(, 3), "S")
        
        For k = 1 To (n - 1)
            r.Offset(k).Insert Shift:=xlShiftDown
            r.Copy r.Offset(k)
            
            shrp = sharp(flat(r.Offset(k, 3).Resize(, 7)), n)
            For g = 1 To 7
                r.Offset(k, 3).Cells(g) = Mid(Split(shrp, ",")(k), g, 1)
            Next
        Next
        
        If n > 1 Then
            r.Offset(, 3).Resize(, 7) = "N"
            r.Offset(, 3).Cells(InStr(shrp, "S")) = "S"
        End If
    Next
End Sub


Private Function flat(r As Range) As String
Dim v As Variant, s As String
    For Each v In r
        s = s & v
    Next
    flat = s
End Function

Private Function sharp(s As String, n As Integer)
Dim i As Integer, t As String, m As Integer, z As String

    t = "": m = 0
    For i = 1 To n
        m = InStr(1 + m, s, "S")
        z = String(Len(s), "N")
        Mid(z, m, 1) = "S"
        t = t & z & ","
    Next
    sharp = Replace(t & "@", ",@", "")
End Function

di sao (utente non iscritto) data: 16/10/2012 17:43:01
Super....grazie!
di Vecchio Frac data: 16/10/2012 17:51:33
Hai spuntato "Risolto" ?
Ma scherzi?! Quello che ho postato è una cosa inguardabile (anche se funziona) :)
Coraggio, al lavoro con le ottimizzazioni :)

Vuoi Approfondire?