Не видя ваших данных и способа передачи данных, очень сложно дать вам ответ.Я подозреваю, что именно поэтому вы не получили ответов на свои посты.
Я предполагаю, что есть неплохой шанс, что ваши уравнения Excel просто отформатируются как символы под- и суперскриптов, так что опция может бытьвыполнить преобразование Unicode в самом Excel.
Приведенный ниже код должен помочь вам начать работу - хотя, я уверен, вы уже читали, что этот сайт не является бесплатной службой написания кода, поэтому вы 'Мне нужно изменить и / или расширить его в соответствии с вашими потребностями.Он в основном создает карту под- и надстрочных символов в их эквиваленты Юникода, а затем преобразует любые символы, которые он может найти на карте.Если нет совпадения, он закрасит символ красным.
Я подозреваю, что это будет самый простой способ для вас.Другим вариантом будет преобразование каждого элемента при записи его в базу данных, но, не видя ваш код, я не смогу создать для вас рабочий пример.
Удачи.
Option Explicit
Public Sub RunMe()
Dim ws As Worksheet
Dim cell As Range
Dim map As Collection, unresolveds As Collection
Dim i As Long
Dim str As String
Dim v As Variant
'Create the map of sub- and superscripts.
Set map = GetScriptsMap
'Create the output sheet.
With ThisWorkbook.Worksheets
Set ws = .Add(After:=.Item(.Count))
End With
'Iterate each cell in the range.
For Each cell In Sheet1.UsedRange.Cells
If cell.Characters.Count > 0 Then
'Reset the collection of unresolved characters.
Set unresolveds = New Collection
'Iterate the text character by character.
For i = 1 To cell.Characters.Count
With cell.Characters(i, 1)
str = .Text
With .Font
'Check for sub- or superscript.
If .Subscript Or .Superscript Then
'Attempt a lookup of sub- or superscript characters.
'If the lookup fails, the str variable will hold its
'old .Text value.
On Error Resume Next
str = ChrW(map(str & IIf(.Subscript, "B", "P")))
'A failed lookup will return an error number,
'so add it to the collection of unresolved characters.
If Err.Number > 0 Then unresolveds.Add i
On Error GoTo 0
End If
End With
End With
'Build the output cell.
With ws.Range(cell.Address)
.Value = .Value & str
End With
Next
'Colour the unresolved characters red.
For Each v In unresolveds
ws.Range(cell.Address).Characters(v, 1).Font.Color = vbRed
Next
End If
Next
End Sub
Private Function GetScriptsMap() As Collection
Dim map As Collection
Set map = New Collection
'Superscript unicodes - key suffixed with 'P'
map.Add &H2070, "0P"
map.Add &H2071, "1P"
map.Add &HB2, "2P"
map.Add &HB3, "3P"
map.Add &H2074, "4P"
map.Add &H2075, "5P"
map.Add &H2076, "6P"
map.Add &H2077, "7P"
map.Add &H2078, "8P"
map.Add &H2079, "9P"
map.Add &H207A, "+P"
map.Add &H207B, "-P"
map.Add &H207C, "=P"
map.Add &H207D, "(P"
map.Add &H207E, ")P"
map.Add &H207F, "nP"
'Subscript unicodes - key suffixed with 'B'
map.Add &H2080, "0B"
map.Add &H2081, "1B"
map.Add &H2082, "2B"
map.Add &H2083, "3B"
map.Add &H2084, "4B"
map.Add &H2085, "5B"
map.Add &H2086, "6B"
map.Add &H2087, "7B"
map.Add &H2088, "8B"
map.Add &H2089, "9B"
map.Add &H208A, "+B"
map.Add &H208B, "-B"
map.Add &H208C, "=B"
map.Add &H208D, "(B"
map.Add &H208E, ")B"
map.Add &H2090, "aB"
map.Add &H2091, "eB"
map.Add &H2092, "oB"
map.Add &H2093, "xB"
map.Add &H2094, ChrW(&H18F) & "B"
map.Add &H2095, "hB"
map.Add &H2096, "kB"
map.Add &H2097, "lB"
map.Add &H2098, "mB"
map.Add &H2099, "nB"
map.Add &H209A, "pB"
map.Add &H209B, "sB"
map.Add &H209C, "tB"
Set GetScriptsMap = map
End Function