concatenare celle

Hai un problema con Excel?

Nuova discussione

S.o.s macro :)
di Michele (utente non iscritto) data: 13/10/2009
Buongiorno a tutti. ho una tabella excel di cui vi riporto qui sotto i dati:

a1="nome"
b1="classe"
a2=piero
a3=maria
a4=carlo
a5=pina
a6=franco
a7=angela

b2=1
b3=1
b4=1
b5=2
b6=2
b7=2

d2=1
d4=2

devo inserire una macro (o una funzione, se la conoscete!) che stampi in sequenza, nella cella e(x), quei nomi della colonna a cui è associato, nella colonna b, lo stesso valore della cella d(x).

in altre parole, il risultato desiderato è:
e2=pieromariacarlo
e4=pinafrancoangela

non riesco a venirne a capo. potete aiutarmi?
grazie del vostro tempo in ogni caso
michele
S.o.s macro :)
di Michele (utente non iscritto) data: 13/10/2009
Buongiorno a tutti. ho una tabella excel di cui vi riporto qui sotto i dati:

a1="nome"
b1="classe"
a2=piero
a3=maria
a4=carlo
a5=pina
a6=franco
a7=angela

b2=1
b3=1
b4=1
b5=2
b6=2
b7=2

d2=1
d4=2

devo inserire una macro (o una funzione, se la conoscete!) che stampi in sequenza, nella cella e(x), quei nomi della colonna a cui è associato, nella colonna b, lo stesso valore della cella d(x).

in altre parole, il risultato desiderato è:
e2=pieromariacarlo
e4=pinafrancoangela

non riesco a venirne a capo. potete aiutarmi?
grazie del vostro tempo in ogni caso
michele
Scusate la ripetizione
di Michele (utente non iscritto) data: 13/10/2009
Scusate la ripetizione. devo aver dato il comando di invio due volte:)

michele

di Enzo (utente non iscritto) data: 14/10/2009
Provala e fa sapere
bye

Sub accorpa()
Set RNG = [a1].Parent.UsedRange
ultimariga = RNG.Find(What:="*", _
                       After:=RNG.Cells(1), _
                       Lookat:=xlPart, _
                       LookIn:=xlFormulas, _
                       SearchOrder:=xlByRows, _
                       SearchDirection:=xlPrevious, _
                       MatchCase:=False).Row
For I = 2 To ultimariga
For h = 2 To ultimariga
If Range("d" & I) <> "" Then
If Range("d" & I) = Range("b" & h) Then
nome = nome & Range("a" & h).Value
End If
End If
Next h
Range("e" & I) = nome
nome = ""
Next I
End Sub

Quasiperfettoquasiperfetto:)
di Michele (utente non iscritto) data: 14/10/2009
Ciao enzo. la macro stampa esattamente quello che vorrei... però due volte!

e2= ma/mo/mi/ma/mo/mi/
e4= peterpinopeterpino

grazie della tua risposta in ogni caso.
michele
di Enzo (utente non iscritto) data: 14/10/2009
Io l'ho provato e seguendo l'impostazione del tuo esempio fa quello che avevi chiesto
in ogni caso ti ho allegato un file (esempio)dove ho inserito i valori nelle celle da te indicate e se fai partire la macro accorpa i nomi come avevi chiesto
prova e fai sapere
Oops...
di Michele (utente non iscritto) data: 14/10/2009
Ciao enzo. la colpa è mia. nel file su cui ho testato la macro (che è un pò diverso da quello che ho postato), la tabella veniva ripetuta due volte, sopra e sotto, perciò la macro stampava, da brava, due volte. cancellata la seconda tabella, il problema si è completamente risolto.

grazie.
sei stato gentilissimo :)
michele
di Enzo (utente non iscritto) data: 16/10/2009
No problem

Aiutooooooooooooooo!!!!!!!!!!!!!!!!!!11
di Stefano (utente non iscritto) data: 16/11/2009
Ciao a tutti ho un problema con una macro che non ho fatto io ma serve per per il mio lavoro. trasforma l'importo scritto in cifre in lettere.
il mio problema è questo tale macro dovrebbe trasformare gli importi in cifre scritti nelle righe da c2 a c51 in importi corrispondenti scritti in lettere nelle righe da d2 a d51.
purtroppo la macro che ho io lo fa solo per una riga per volta e se provo a farne diverse modificando i dati delle due righe non si memorizzano. volevo chiedere se è possibile inserire una variabile( credo si chiami così) che permetta di ottenere il risultato che desidero per tutte le righe in contemporanea.
intanto inserisco la macro. se qualcuno mi aiuto diciamo che mi salvo il posto. grazieeeeeeeeee

Public dator As Variant
Public lettere As Variant

Sub conversione()
Sheets("ELENCO nOMINATIVI").Select
numa = Range("C3")
leta = ("D3")
Select Case Range("C2")
leta = ("d2")
    dator = numa
    
    ff = IsNumeric(dator)
    If ff = False Then
      GoTo nexta
        End If
        
    
        If dator = 0 Then
    Range(leta) = ""
    GoTo nexta
    End If
 decix = dator * 100
 dator = Int(dator) * 100
  decim = decix - dator
  If Len(decim) = 1 Then decim = "0" & decim
 valut = "e"
 
If decim + 0 > 0 And UCase(valut) <> "E" Then
MsgBox "Presenti decimali in una richiesta diversa da 'E' (Euro)"
GoTo nexta
End If

simbeuro = "€"
 dator = Int(numa)
 calcola
  Range(leta) = lettere
  If decim > 0 Then
  If Len(decim) = 1 Then decim = decim * 10
   Range(leta) = Range(leta) & "/" & decim
   Else
   Range(leta) = Range(leta) & "/00"
 
  End If
  
nexta:
       

     End Sub

Sub calcola()
lettere = ""
    x = dator
unita = Array("zero", "uno", "due", "tre", "quattro", "cinque", "sei", "sette", "otto", "nove")
deci = Array("dieci", "undici", "dodici", "tredici", "quattordici", "quindici", "sedici", "diciasette", "diciotto", "diciannove")
decine = Array("vuoto", "venti", "trenta", "quaranta", "cinquanta", "sessanta", "settanta", "ottanta", "novanta")

GoSub Azzera

'IMPORTI   IN  MILIARDI
If dator > 999999999 And dator < 1000000000000# Then
num = dator

migl = Int(num / 10 ^ 9)
   If migl >= 10 ^ 2 Then
   cent = Int(migl / 10 ^ 2)
    num = migl - cent * 10 ^ 2
    End If
    If migl >= 10 And migl <= 99 Then
     num = migl
    End If
         If migl >= 10 Then
           dec = Int(num / 10)
           num = num - dec * 10
          unit = num
        End If
        If num < 10 Then unit = num

    End If
   
 If dator > 999999999 And dator < 1000000000000# Then
           If migl = 1 Then
             lettere = lettere & "unmiliardo"
              unit = 0
             End If
             If migl > 1 And migl <= 9 Then
            lettere = lettere & unita(migl)
          End If
          If cent = 1 Then
             lettere = lettere & "cento"
          ElseIf cent > 1 Then
            lettere = lettere & unita(cent) & "cento"
              End If
         
          If dec = 1 Then
          lettere = lettere & deci(unit)
          unit = 0
           End If
       If dec > 1 Then lettere = lettere & decine(dec - 1)
       If (dec > 1 And unit = 1) Or (dec > 1 And unit = 8) Then
          lettere = Mid(lettere, 1, Len(lettere) - 1)
       End If
       If unit > 0 Then lettere = lettere & unita(unit)
 dator = dator - migl * 10 ^ 9
 If migl > 1 Then lettere = lettere & "miliardi"
    End If
    
GoSub Azzera

'IMPORTI   IN  MILIONI
If dator > 999999 And dator < 1000000000 Then
num = dator

migl = Int(num / 10 ^ 6)
   If migl >= 10 ^ 2 Then
   cent = Int(migl / 10 ^ 2)
    num = migl - cent * 10 ^ 2
    End If
     If migl >= 10 And migl <= 99 Then
     num = migl
    End If
         If migl >= 10 Then
           dec = Int(num / 10)
           num = num - dec * 10
          unit = num
        End If
        If num < 10 Then unit = num

    End If
   
 If dator > 999999 And dator < 1000000000 Then
           If migl = 1 Then
             lettere = lettere & "unmilione"
              unit = 0
             End If
             If migl > 1 And migl <= 9 Then
            lettere = lettere & unita(migl)
          End If
          If cent = 1 Then
             lettere = lettere & "cento"
          ElseIf cent > 1 Then
            lettere = lettere & unita(cent) & "cento"
              End If
         
          If dec = 1 Then
          lettere = lettere & deci(unit)
          unit = 0
           End If
       If dec > 1 Then lettere = lettere & decine(dec - 1)
       If (dec > 1 And unit = 1) Or (dec > 1 And unit = 8) Then
          lettere = Mid(lettere, 1, Len(lettere) - 1)
       End If
       If unit > 0 Then lettere = lettere & unita(unit)
 dator = dator - migl * 10 ^ 6
 If migl > 1 Then lettere = lettere & "milioni"
    End If
    
GoSub Azzera

'IMPORTI   IN  MIGLIAIA
If dator > 999 And dator < 1000000 Then
num = dator

migl = Int(num / 10 ^ 3)
   If migl >= 10 ^ 2 Then
   cent = Int(migl / 10 ^ 2)
    num = migl - cent * 10 ^ 2
    End If
     If migl >= 10 And migl <= 99 Then
     num = migl
    End If
         If migl >= 10 Then
           dec = Int(num / 10)
           num = num - dec * 10
          unit = num
        End If
        If migl < 10 Then unit = migl

    End If
   
 If dator > 999 And dator < 1000000 Then
           If migl = 1 Then
             lettere = lettere & "mille"
            unit = 0
            End If
             
          If cent = 1 Then
             lettere = lettere & "cento"
          ElseIf cent > 1 Then
            lettere = lettere & unita(cent) & "cento"
              End If
          If dec = 1 Then
          lettere = lettere & deci(unit)
          unit = 0
          End If
          
       If dec > 1 Then lettere = lettere & decine(dec - 1)
       If (dec > 1 And unit = 1) Or (dec > 1 And unit = 8) Then
          lettere = Mid(lettere, 1, Len(lettere) - 1)
       
       End If
      
       If unit > 0 Then lettere = lettere & unita(unit)
 dator = dator - migl * 10 ^ 3
 If migl > 1 Then lettere = lettere & "mila"
    End If
    
GoSub Azzera

'IMPORTI   IN   CENTINAIA
If dator > 0 And dator <= 999 Then
    num = dator
         If num >= 10 ^ 2 Then
           cent = Int(num / 10 ^ 2)
           num = num - cent * 10 ^ 2
         End If
         If num >= 10 Then
           dec = Int(num / 10)
           num = num - dec * 10
          unit = num
        End If
        If num < 10 Then unit = num
    End If
   
 If dator > 0 And dator <= 999 Then
          If cent = 1 Then
             lettere = lettere & "cento"
             
          ElseIf cent > 1 Then
           lettere = lettere & unita(cent) & "cento"
              End If
          If dec = 1 Then
          lettere = lettere & deci(unit)
          unit = 0
           End If
          
       If dec > 1 Then
       lettere = lettere & decine(dec - 1)
       End If
       
       If (dec > 1 And unit = 1) Or (dec > 1 And unit = 8) Then
          lettere = Mid(lettere, 1, Len(lettere) - 1)
                     End If
       
       If unit > 0 Then
       lettere = lettere & unita(unit)
    End If
     End If
    Exit Sub
Azzera:
cent = 0
num = 0
dec = 0
unit = 0
migl = 0
Return
 
    
 End Sub

di Enzo (utente non iscritto) data: 17/11/2009
Prova l'istruzione qui sotto
fa quello che ti serve e puoi incrementarei valori che ti servono
fai sapere se .......il posto lo hai salvato

p.s. prossima volta apri una discussione nuova

Dim N$(100), M$(100)
For I = 2 To 51 'QUI PUOI INCREMENTARE LE CELLE 52 100 QUELLO CHE VUOI
Range("C" & I).Select   'cella col numero da convertire
Num = ActiveCell.Value
N$(0) = ""
N$(1) = "uno"
N$(2) = "due"
N$(3) = "tre"
N$(4) = "quattro"
N$(5) = "cinque"
N$(6) = "sei"
N$(7) = "sette"
N$(8) = "otto"
N$(9) = "nove"
N$(10) = "dieci"
N$(11) = "undici"
N$(12) = "dodici"
N$(13) = "tredici"
N$(14) = "quattordici"
N$(15) = "quindici"
N$(16) = "sedici"
N$(17) = "diciassette"
N$(18) = "diciotto"
N$(19) = "diciannove"
M$(0) = ""
M$(2) = "venti"
M$(3) = "trenta"
M$(4) = "quaranta"
M$(5) = "cinquanta"
M$(6) = "sessanta"
M$(7) = "settanta"
M$(8) = "ottanta"
M$(9) = "novanta"
M$(10) = "Cento"
NN$ = LTrim$(Str$(Num))

If Len(NN$) > 6 Then
Milioni$ = Left$(NN$, Len(NN$) - 6)
NN$ = Right$(NN$, 6)
End If
If Len(NN$) > 3 Then
Migliaia$ = Left$(NN$, Len(NN$) - 3)
NN$ = Right$(NN$, 3)
End If

GoSub Ciclo
LLL$ = LL$
NN$ = Migliaia$
If Migliaia$ = "1" Then
LLL$ = "mille" + LLL$
Else
GoSub Ciclo
If Len(LL$) > o Then LLL$ = LL$ + "mila" + LLL$
End If

NN$ = Milioni$
If Milioni$ = "1" Then
LLL$ = "unmilione" + LLL$
Else
GoSub Ciclo
If Len(LL$) > o Then LLL$ = LL$ + "milioni" + LLL$
End If
Range("D" & I).Select     'cella che riporta la conversione il lettere
ActiveCell.Value = LLL$
GoTo Fine

Ciclo:
LL$ = ""
Num0 = Val(NN$)
If Len(NN$) = 2 Then NN$ = "0" + NN$
If Len(NN$) = 1 Then NN$ = "00" + NN$
Num3 = Val(Right$(NN$, 1))
Num2 = Val(Mid$(NN$, 2, 1))
Num1 = Val(Left$(NN$, 1))
If Num0 > 99 Then
If Num0 > 199 Then LL$ = N$(Num1)
LL$ = LL$ + "cento"
End If

If Num2 > 1 Then
LL$ = LL$ + M$(Num2)
If Num3 > 0 Then
If Num3 = 1 Or Num3 = 8 Then LL$ = Left$(LL$, Len(LL$) - 1)
LL$ = LL$ + N$(Num3)
End If
End If
If Num2 < 2 Then
LL$ = LL$ + N$(Num3 + Num2 * 10)
End If
Return
Fine:
Next I

Vuoi Approfondire?