Inserire la function Rotonda nella cella corrente utilizzando VBA

Sto cercando di rendere più facile inserire la function Rotonda in un numero di celle che già dispongono di formule in essi.

Ad esempio, se la cella A1 ha la formula =b1+b2 , dopo l'uso di questa macro, voglio che il contenuto della cella sia letto =Round(b1+b2,) . Le formule in ciascuna delle celle non sono le stesse, quindi la parte b1+b2 deve essere qualsiasi cosa.

  • Excel - Pivot Slicer o Via VBA?
  • Come aggiungere una formula come prefisso / suffisso a più celle di text (nelle loro celle originali)
  • Excel - Duplicare un colore della cella basato su un colore della cella su un altro foglio
  • come abbinare i dati in due excel ed esportre in un nuovo
  • Come get il valore di una cella in una posizione specificata in un foglio Excel utilizzando JAVA
  • Risolto: utilizzando sottototali per creare un'altra colonna ponderata
  • Tutto quello che posso fare è questo:

     Sub Round() Activecell.FormulaR1C1 = "=ROUND(b1+b2,)" End Sub 

    Quindi cerco davvero un modo per get la formula in una cella selezionata e quindi modificare questi contenuti utilizzando VBA. Non riesco a trovare la risposta da nessuna parte.

  • Verifica che il foglio di calcolo sia protetto
  • Come posso concatenare la cella iniziale di parte 1 con tutta la cella 2 e finire con il resto della cella 1?
  • excel - utilizzare l'indice corrispondente per trovare il risultato di più colonne e righe
  • excel vba riempimento arrays
  • Imansible interrogare intervallo dinamico denominato in foglio Excel utilizzando ADO
  • Excel - confronto di una cella con un valore concatenato in un'istruzione IF
  • 5 Solutions collect form web for “Inserire la function Rotonda nella cella corrente utilizzando VBA”

    Cosa ne pensi di questo?

     Sub applyRound(R As Range) If Len(R.Formula) > 0 Then If Left(R.Formula, 1) = "=" Then R.Formula = "=round(" & Right(R.Formula, Len(R.Formula) - 1) & ",1)" End If End If End Sub 

    Questa è una variante sulla base di approccio di Brettville sul codice che ho scritto su un altro forum che

    1. Funziona su tutte le celle di formula nella selezione corrente
    2. Utilizza arrays, SpecialCells e funzioni di string per ottimizzare la velocità. Looping attraverso le gamme può essere molto lento se si dispone di molte celle

       Sub Mod2() Dim rng1 As Range Dim rngArea As Range Dim i As Long Dim j As Long Dim X() Dim AppCalc As Long On Error Resume Next Set rng1 = Selection.SpecialCells(xlFormulas) On Error GoTo 0 If rng1 Is Nothing Then Exit Sub With Application AppCalc = .Calculation .ScreenUpdating = False .Calculation = xlCalculationManual End With For Each rngArea In rng1.Areas If rngArea.Cells.Count > 1 Then X = rngArea.Formula For i = 1 To rngArea.Rows.Count For j = 1 To rngArea.Columns.Count X(i, j) = "=ROUND(" & Right$(X(i, j), Len(X(i, j)) - 1) & ",1)" Next j Next i rngArea = X Else rngArea.Value = "=Rround(" & Right$(rngArea.Formula, Len(rngArea.Formula) - 1) & ",1)" End If Next rngArea With Application .ScreenUpdating = True .Calculation = AppCalc End With End Sub 

    Typo sulla seconda function " =round " è stato digitato come " =Rround ". Una volta modificato con un giro di 2, invece di 1, il process ha funzionato ottimo per me. Posso aggiungere un'altra dichiarazione if per verificare se esiste già una formula " =round " per impedire a qualcuno di eseguire più di una volta o di arrotondare all'interno di un round.

    Darryl

    Il programma completamente modificato sarebbe come questo

      Sub Round_Formula() Dim c As Range Dim LResult As Integer Dim leftstr As String Dim strtemp As String Set wSht1 = ActiveSheet Dim straddress As String Dim sheet_name As String sheet_name = wSht1.Name 'MsgBox (sheet_name) straddress = InputBox(Prompt:="Full cell Address where to insert round function as D8:D21", _ Title:="ENTER Address", Default:="D8:D21") With Sheets(sheet_name) For Each c In .Range(straddress) If c.Value <> 0 Then strtemp = c.Formula 'MsgBox (strtemp) LResult = StrComp(Left(strtemp, 7), "=ROUND(", vbTextCompare) 'MsgBox ("The value of LResult is " & LResult) If LResult <> 0 Then 'c.Formula = "=ROUND(" & Right(c.Formula, Len(c.Formula) - 1) & ",2)" c.Formula = "=ROUND(" & Right(c.Formula, Len(c.Formula) - 1) & ",0)" End If End If Next c End With End Sub 

    Prova questo

    Per each n nella selezione N.formula = "round (" & mid (n.formula, 2,100) & ", 1)" Successivo n

    Ho assunto che la lunghezza della formula esistente è inferiore a 100 caratteri e la sensibilità è 1. È ansible modificare questi valori

    Microsoft Office Excel Spreadsheet è il miglior software di Office, Excel VBA e formule Excel rendono il foglio di calcolo più veloce.