Преобразование единиц и значений в ячейках в стандартную единицу

Question

Я должен интерпретировать данные для научных отчетов. Мы сообщаем данные все в тех же единицах. Однако лаборатория отправляет данные в разных единицах. Например, лаборатория может отправить результаты в мкг (микрограммы), и нам нужно преобразовать их в мг (миллиграммы). Поэтому я хотел бы знать, как создать макрос, который можно применить к столбцу или строке для преобразования результатов (т.е. разделить число результатов на 1000).

У меня проблема в том, что данные обычно смешиваются с разными единицами в одном столбце. Следовательно, макрос нужно применять только к результатам, которые имеют неправильную единицу измерения (т. Е. Только результаты, уже полученные в ug, необходимо преобразовать в мг).

Поскольку мои данные часто содержат тысячи строк, это действительно должен быть макрос, чтобы я мог выделить строку и запустить макрос. Затем он заменит содержимое ячеек «сообщенных результатов» пересмотренными цифрами и обновит ячейки «единиц результата» с исправленными единицами.

Пример данных, которые я получаю, выглядит следующим образом:

Если у кого-то есть идеи, я был бы очень благодарен.

Answer 1

Вот довольно простой, но надежный и умный макрос, который нормализует микрограммы до миллиграммов:

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

Это на самом деле настолько умно, что вы можете выбрать что угодно, целые строки, целые столбцы, отдельные ячейки, даже несмежные диапазоны, и он найдет и нормализует все соответствующие значения / единицы.

Заметки:

• Значения, которым предшествует < или > , корректно нормализованы
• Если значение не указано или не является числом, оно и единица остаются без изменений