Conversion des unités et des valeurs dans les cellules en une unité standard

0

Je dois interpréter les données pour les rapports scientifiques. Nous rapportons les données dans les mêmes unités. Cependant, le laboratoire envoie les données dans différentes unités. Par exemple, le laboratoire peut envoyer les résultats en ug (microgrammes) et nous devons le convertir en mg (milligrammes). J'aimerais donc savoir comment créer une macro que vous pouvez appliquer à une colonne ou à une ligne pour convertir les résultats (c'est-à-dire diviser le nombre de résultats par 1000).

Le problème que j'ai est que les données sont normalement mélangées, avec différentes unités dans la même colonne. Par conséquent, la macro ne doit être appliquée qu'aux résultats dont l'unité est incorrecte (autrement dit, seuls les résultats déjà exprimés en ug doivent être convertis en mg).

Comme mes données comprennent souvent des milliers de lignes, il doit s'agir d'une macro pour que je puisse surligner une ligne et l'exécuter. Il remplacerait ensuite le contenu des cellules "résultats rapportés" par les chiffres révisés et actualiserait également les cellules "unités de résultats" avec l'unité corrigée.

Voici un exemple des données que je reçois:

Exemple de données de laboratoire reçues

Si quelqu'un a des idées, je vous en serais très reconnaissant.

Riches
la source
Je peux suggérer que Macro convertira toutes les valeurs de Microgram en Miligram sauf les valeurs qui ont un <signe. Mais je peux vous suggérer une formule pour convertir ces valeurs (<1) de ug en mg, confirmez-vous que cela fonctionnera pour vous?
Rajesh S

Réponses:

1

Voici une macro assez simple, mais robuste et intelligente, qui normalise des microgrammes en milligrammes:

'============================================================================================
' Module     : <any standard module>
' Version    : 0.1.0
' Part       : 1 of 1
' References : N/A
' Source     : https://superuser.com/a/1333314/763880
'============================================================================================
Option Explicit

Public Sub NormaliseUnits()
       Dim ¡ As Long

  Dim rngTarget As Range
  For Each rngTarget In Selection.Areas
    'Minimise the number of cells to be processed
    Set rngTarget = Intersect(rngTarget, rngTarget.Parent.UsedRange)
    If rngTarget Is Nothing Then Exit For 'Nothing to do as the mimimised Area doesn't contain any data
    ' Expand the minimised target to include the previous column:
    If rngTarget.Column > 1 Then
      Set rngTarget = rngTarget.Offset(ColumnOffset:=-1).Resize(ColumnSize:=rngTarget.Columns.Count + 1)
    End If
    ' Expand the minimised target to include the next column:
    If rngTarget.Column + rngTarget.Columns.Count - 1 < Columns.Count Then
      Set rngTarget = rngTarget.Resize(ColumnSize:=rngTarget.Columns.Count + 1)
    End If
    ' Loop through all cells (skipping the first column) looking for a "ug" to fix
    Dim rngRow As Range
    For Each rngRow In rngTarget.Rows
      For ¡ = 2 To rngRow.Columns.Count
        If rngRow.Cells(¡) = "ug" _
        And rngRow.Cells - 1) <> vbNullString _
        Then
          Dim strValue As String: strValue = CStr(rngRow.Cells - 1).Value2)
          Dim strLessThan As String: strLessThan = vbNullString
          If InStr("<>", Left$(strValue, 1)) Then
            strLessThan = Left$(strValue, 1)
            strValue = Mid$(strValue, 2)
          End If
          If IsNumeric(strValue) Then
            rngRow.Cells - 1).Value2 = strLessThan & CStr(CDbl(strValue) / 1000)
            rngRow.Cells(¡) = "mg"
          End If
        End If
      Next ¡
    Next rngRow
  Next rngTarget

End Sub

En fait, il est si intelligent que vous pouvez sélectionner n’importe quoi, des rangées entières, des colonnes entières, des cellules uniques, même des plages disjointes, et il trouvera et normalisera toutes les valeurs / unités appropriées.

Remarques:

  • Les valeurs précédées d'un < ou > sont correctement normalisées
  • Si la valeur est vide ou pas un nombre, celui-ci et l'unité restent inchangés
robinCTS
la source