Convertendo as unidades e valores nas células para uma unidade padrão

0

Eu tenho que interpretar dados para relatórios científicos. Nós relatamos os dados todos nas mesmas unidades. No entanto, o laboratório envia os dados em diferentes unidades. Por exemplo, o laboratório pode enviar os resultados em ug (microgramas) e precisamos convertê-lo em mg (miligramas). Portanto, gostaria de saber como criar uma macro que você pode aplicar a uma coluna ou linha para converter os resultados (isto é, dividir o número do resultado por 1000).

O problema que tenho é que os dados são normalmente misturados, com unidades diferentes na mesma coluna. Portanto, a macro só precisa ser aplicada aos resultados que têm a unidade incorreta (ou seja, somente os resultados já em ug precisam ser convertidos em mg).

Como meus dados geralmente incluem milhares de linhas, ele realmente precisa ser uma macro para que eu possa destacar uma linha e executar a macro. Em seguida, substituiria o conteúdo das células de 'resultados relatados' pelos valores revisados e atualizaria as células de 'unidades de resultados' com a unidade corrigida também.

Um exemplo dos dados que recebo é o seguinte:

Se alguém tiver alguma ideia, eu ficaria muito grato.

    
por Rich 21.06.2018 / 23:18

1 resposta

1

Aqui está uma macro bastante simples, mas robusta e inteligente, que normaliza microgramas a miligramas:

'============================================================================================
' 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

Na verdade, é tão inteligente que você pode selecionar qualquer coisa, linhas inteiras, colunas inteiras, células únicas, até mesmo intervalos não contíguos, e encontrará e normalizará todos os valores / unidades apropriados.

Notas:

  • Os valores precedidos por < ou > são corretamente normalizados
  • Se o valor estiver em branco ou não for um número, ele e a unidade permanecerão inalterados
por 22.06.2018 / 05:06