Colonna in Lettere

Hai un problema con Excel?

Nuova discussione

Colonna in Lettere
di Raffaele_53 data: 01/08/2015 22:52:53
Ciao a tutti
Devo fare un ciclo FOR in colonna+righe (circa 4/5 milioni di calcoli).

Pensavo di mettere all'inizio una sigla che descrive quale colonna sia moltiplicata per l'altra colonna EX =colonna(A)*colonna(B) e in cella successiva il risultato

Nel ciclo FOR la colonna è selezionata dalla X
Non posso usare Cells(1, 1) = Columns(X)

Esiste un modo per ricavare la colonna d'origine (in lettere "a parte UDF", che presumo diventerà tutto più lento insieme ai calcoli)?
Ps. UDF per lettere c'è lo già
di isy data: 01/08/2015 23:14:40
Allega un file che riporti i passaggi, un esempio con formule..
di Raffaele_53 data: 02/08/2015 00:41:19
Grazie
Solo un esempio, per come intendo fare il ciclo FOR.

da numero a lettera:
Public Function LettCol(ByVal n As Long) As String
LettCol = Replace(Cells(1, n).Address(False, False), "1", "")
End Function

>>>Cells(Rg, 1) = LettCol(X) & " _ " & LettCol(Y) & " _ " & LettCol(R)
EDIT nel risponderTi ho capito che non diventa lento (solo un poco), pertanto ci riesco. Grazie lo stesso EDIT

di isy data: 02/08/2015 02:02:18
Con gli array se ho interpretato correttamente, potresti evitare i continui riferimenti alle celle
Da testare attentamente sul tuo foglio

Option Explicit

Sub calcola()
Dim X As Long, Y As Long, R As Long, Rg As Long
Dim K                                   As Long
Dim Col                                 As Long
Dim Arr(), Data

Data = Range("B1:BK1")            'Original List
Col = UBound(Application.Transpose(Data))
For X = 1 To Col - 3
  For Y = X To Col - 3
    For R = Y To Col - 3
      K = K + 1
    Next
  Next
Next
ReDim Arr(1 To K, 1 To 1)
  For X = 1 To Col - 3
    For Y = X + 1 To Col - 2
      For R = Y + 1 To Col - 1
        Rg = Rg + 1
        Arr(Rg, 1) = Data(1, X) * Data(1, Y) * Data(1, R)
      Next
    Next
  Next
  [A2].Resize(K) = Arr
End Sub

di Vecchio Frac data: 02/08/2015 10:59:55
Cioè è una somma dei valori delle celle ordinate con combinazioni senza ripetizioni?
di Raffaele_53 data: 02/08/2015 13:02:43
Si tratta di fare calcoli tra tutte le combinazioni di 61 colonne (totale combinazioni 35991).
Siccome non potevo svilupparlo orizzontalmente (colonne insufficenti), ho "trasposto" il tutto in verticale. Facendo cosi però vedo solo il risultato e non vedo a quali colonne appartengono. Ho una sigla "2*B-(C+D)" che descrive a quali colonne è riferito il numero. Ieri sera mentre rispondevo mi sono accorto che non dovevo farlo ogni volta, bastava farlo solo una volta per la colonna A

Purtroppo mi sembra lento (raf.xlsm) 5 minuti per 4 colonne
In teoria ci dovrebbe essere centinaia di righe. Attualmente For R = 5 To 8

Ringrazio ISY per l'aiuto, mi piacerebbe provarlo per vedere se è più veloce, mà non so come adattarlo.
di Vecchio Frac data: 02/08/2015 13:41:04
@rafafele
A me la medesima procedura di isy nel tuo file "raf.xlsm" ci ha messo 14 secondi e spiccioli per fare le quattro colonne di 37mila righe e passa. Per le 96 colonne in totale ci metterebbe quindi 22 minuti e mezzo, decisamente tanto.
Non ho dovuto fare adattamenti e mi pare che i risultati siano giusti con le formule indicate.
di Raffaele_53 data: 02/08/2015 14:55:58
Ciao a tutti
l'ho riavviato per tutte le 96 colonne e ci ha messo 8 minuti. Bho
Grazie a Voi comunque
di isy data: 02/08/2015 20:54:42
Ciao

Vedo che hai risolto,
Ho ridotto i tempi di elaborazione ad 8 secondi se può interessare.
di Marius44 data: 02/08/2015 22:34:59
Salve a tutti
Me la sono vista dalla ... finestra ma ho effettuato delle provato anch'io (prove sul tempo impiegato non su variazioni alla sub): decisamente troppo.

@isy
anche se Raffaele_53 ha risolto, visti i tempi da te dichiarati, mi piacerebbe sapere, se possibile, come hai fatto (il copyright rimane tuo, ovviamente).
Grazie e ciao,
Mario

di isy data: 02/08/2015 22:51:49
Ciao Marius44

Allego il codice che ho utilizzato.

Option Explicit

Public Function LettCol(ByVal n As Long) As String
  LettCol = Replace(Cells(1, n).Address(False, False), "1", "")
End Function

Sub calcolaG()
  Dim X As Long, Y As Long, R As Long, Rg As Long
  Dim K                                   As Long
  Dim Col                                 As Long
  Dim Arr(), Datax
  Dim A, B, Up, Ur, Ciclo, W, Id
  Up = 5
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
  End With
  Foglio2.Cells.ClearContents
  With Foglio1
    Ur = .Range("A" & Rows.Count).End(xlUp).Row
    Col = .Rows("5:5" & Columns.Count).End(xlToRight).Column
    For X = 1 To Col - 2
      For Y = X To Col - 2
        For R = Y To Col - 2
          K = K + 1
        Next
      Next
    Next
    ReDim Arr(1 To K, 1 To 1)
    For X = 2 To Col - 2 'ciclo per scrivere le sigle
        For Y = X + 1 To Col - 1
            For W = Y + 1 To Col
            Rg = Rg + 1
                Arr(Rg, 1) = "2*" & LettCol(X) & "-(" & LettCol(Y) & "+" & LettCol(W) & ")"
            Next W
        Next Y
    Next X
    Datax = .Range(.Cells(3, 2), .Cells(3, Col))         'Original List
    Col = UBound(Application.Transpose(Datax))
    Id = .Range(.Cells(Up, 1), .Cells(Ur, 1))
    Foglio2.[B4].Resize(, Ur - Up + 1) = Application.Transpose(Id)
    Foglio2.[A5].Resize(K) = Arr
    For Ciclo = Up To Ur
      Rg = 0
      Datax = .Range(.Cells(Ciclo, 2), .Cells(Ciclo, Col + 1))
      For X = 1 To Col
        A = 2 * Datax(1, X)
        For Y = X + 1 To Col
          B = Datax(1, Y)
          For R = Y + 1 To Col
            Rg = Rg + 1
            Arr(Rg, 1) = A - (B + Datax(1, R))
            
          Next
        Next
      Next
      Foglio2.[B5].Offset(, Ciclo - 5).Resize(K) = Arr
    Next
  End With
  With Application
    .Calculation = xlCalculationAutomatic
    .StatusBar = True
    .ScreenUpdating = True
  End With
End Sub

di Marius44 data: 02/08/2015 23:11:21
Grazie Isy, molto gentile.
Studierò per benino il codice (per adesso ho capito solo che hai impostato il calcolo su "manuale") ma vista l'ora tarda è meglio dormirci sopra e rivedere il tutto domani a mente fresca.
Grazie ancora e ciao
Mario
di Raffaele_53 data: 02/08/2015 23:33:29
Sul mio Pc 25 secondi.
Veramente veloce. Complimenti

Ps. Scusa ISY, i numeri sono esatti.
Alcune DATE vengono invertite giorni/mesi
Per non rovinare il Tuo lavoro. Mi sai dire dove modificare il formatto?
Mi sembra questa >>>Id = .Range(.Cells(Up, 1), .Cells(Ur, 1))

di isy data: 03/08/2015 08:49:53
Ciao Raffaele_53

Ho corretto il problema che hai indicato, ho modificato alcuni passaggi per migliorare i tempi.
Copia l'intero codice da sostituire col precedente
Buone prove!

Option Explicit

Public Function LettCol(ByVal n As Long) As String
  LettCol = Replace(Cells(1, n).Address(False, False), "1", "")
End Function

Sub calcolaG()
  Dim X As Long, Y As Long, R As Long, Rg As Long
  Dim K                                   As Long
  Dim Col                                 As Long
  Dim Ur                                  As Long
  Dim Ciclo                               As Long
  Dim A, B, W
  Dim Arr(), Datax
  Const Up As Long = 5
  
  With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
  End With
  Foglio2.Cells.ClearContents
  With Foglio1
    Ur = .Range("A" & Rows.Count).End(xlUp).Row
    Col = .Rows("5:5" & Columns.Count).End(xlToRight).Column
    For X = 1 To Col - 2
      For Y = X To Col - 2
        For R = Y To Col - 2
          K = K + 1
        Next
      Next
    Next
    ReDim Arr(1 To K, 1 To 1)
    For X = 2 To Col - 2 'ciclo per scrivere le sigle
        A = LettCol(X)
        For Y = X + 1 To Col - 1
            B = LettCol(Y)
            For W = Y + 1 To Col
                Rg = Rg + 1
                Arr(Rg, 1) = "2*" & A & "-(" & B & "+" & LettCol(W) & ")"
            Next W
        Next Y
    Next X
    Datax = .Range(.Cells(3, 2), .Cells(3, Col))         'Original List
    Col = UBound(Application.Transpose(Datax))
    
    .Range(.Cells(Up, 1), .Cells(Ur, 1)).Copy
    Foglio2.[B4].Resize(, Ur - Up + 1).PasteSpecial Transpose:=True
    Application.CutCopyMode = False
    
    Foglio2.[A5].Resize(K) = Arr
    For Ciclo = Up To Ur
      Rg = 0
      Datax = .Range(.Cells(Ciclo, 2), .Cells(Ciclo, Col + 1))
      For X = 1 To Col
        A = 2 * Datax(1, X)
        For Y = X + 1 To Col
          B = Datax(1, Y)
          For R = Y + 1 To Col
            Rg = Rg + 1
            Arr(Rg, 1) = A - (B + Datax(1, R))
            
          Next
        Next
      Next
      Foglio2.[B5].Offset(, Ciclo - Up).Resize(K) = Arr
    Next
  End With
  With Application
    .Calculation = xlCalculationAutomatic
    .StatusBar = True
    .ScreenUpdating = True
  End With
End Sub

di Marius44 data: 03/08/2015 09:37:35
@isy
Veramente eccezionale. Col mio PC impiega tra i 14 e i 16 secondi (alcune volte sembra bloccarsi e mi indica "non risponde"). Ho seguito passo passo la tua Sub e, credo, che il motivo della velocità sta nel fatto che assegni tutto ad un array e solo alla fine scrivi i risultati. E' così?
Complimenti vivissimi.

@Raffaele_53
Le combinazioni (vedi il valore della variabile K di isy) sono 39711

Congratulazioni ad entrambi.
Ciao,
Mario

di Raffaele_53 data: 03/08/2015 10:46:45
Di nuovo grazie ISY

@Marius44
Nel primo post avevo calcolato solo 60 e non tutte le colonne B...BK = 61
Dopo ho corretto il codice e le righe sono 37820 + (4 vuote all'inizio)

Non sò perchè il K di ISY dichiara 39.711

@Isy
Ultima cortesia, ammettiamo che in alcune celle ci siano errori #N/D (non sò se è testo oppure da formula)
C'è la possibilita di non mandare in errore il VBA?
Sul mio ho scritto le righe sotto però è diventato ancora più lento.

            If IsNumeric(sh1.Cells(R, X)) And IsNumeric(sh1.Cells(R, Y)) And IsNumeric(sh1.Cells(R, W)) Then
                sh2.Cells(Rg, C) = 2 * sh1.Cells(R, X) - (sh1.Cells(R, Y) + sh1.Cells(R, W))
            Else
                sh2.Cells(Rg, C) = 0
            End If

di isy data: 03/08/2015 12:15:23
Ciao

Cit: Dopo ho corretto il codice e le righe sono 37820 + (4 vuote all'inizio)

Per ottenere il valore occorre modificare la seguente routine...

For X = 1 To Col - 2
For Y = X To Col - 2
For R = Y To Col - 3
K = K + 1
Next
Next
Next

Forse esiste un metodo alternativo in vba per calcolarne la dimensione.

di Raffaele_53 data: 03/08/2015 16:24:50
Ho provato a modificarlo con grosse difficoltà. Adesso funziona se ci sono celle in "ERR"

Per la conta delle combinazioni (io faccio cosi), X parte da 2 e deve fermarsi due colonne prima di COL
Y parte da da X+1 e deve fermarsi una colonna prima di COL
R parte da Y+1 e deve fermarsi a COL, totale=37820. Giusto invece in Arr che deve valutarle tutte.

    For Ciclo = Up To Ur
      Rg = 0
      Datax = .Range(.Cells(Ciclo, 2), .Cells(Ciclo, Col + 1))
      For X = 1 To Col
        If IsNumeric(Datax(1, X)) Then A = Datax(1, X) Else A = 0
        For Y = X + 1 To Col
          If IsNumeric(Datax(1, Y)) Then B = Datax(1, Y) Else B = 0
          For R = Y + 1 To Col
            Rg = Rg + 1
            If IsNumeric(Datax(1, X)) And IsNumeric(Datax(1, Y)) And IsNumeric(Datax(1, R)) Then Arr(Rg, 1) = 2 * A - (B + Datax(1, R)) Else Arr(Rg, 1) = "#N/D"
          Next
        Next
      Next

Sub conta()
Col = Rows("6:6" & Columns.Count).End(xlToRight).Column
For X = 2 To Col - 2
For Y = X + 1 To Col - 1
For R = Y + 1 To Col
K = K + 1
Next
Next
Next
MsgBox K
End Sub

Vuoi Approfondire?