Question

我正在研究一个宏，它带有一列单元格，其中包含由＆＃34;分隔的标准列表。＆＃34;如果它们是唯一值，则将它们添加到数组中。我问用户他们想要放置创建的数组，然后将其粘贴到指定位置。

问题 - 几乎所有标准都以＆＃34; 1E＆＃34;每当将数组粘贴到工作表中时，任何不在末尾都有字母的值都会转换为科学计数法。之后我无法将它们格式化为文本，因为它会破坏原始值。例如＆＃34; 1E0011＆＃34;在数组中粘贴为＆＃34; 1.00E + 11＆＃34;。如果我将其格式化为文本（在粘贴之后），则会显示＆＃34; 1E + 11＆＃34;。该数组是Dim＆＃d以作为字符串。

Sub Remove_1E_Duplicates()
'Looks at every "1E" standard in a column and puts every unique value in an array at a user-selected destination

Dim CurrentCell As String               'Used to temporarily store active cell's values
Dim strArray() As String                'Final string with only unique values
Dim tempArray() As String               'Temp array created by splitting CurrentCell's values
Dim i As Integer                        'Counter used for each value in tempArray
Dim elem As Integer                     'Counter for each element in strArray
Dim lLoop As Long, lLoop2 As Long       'Counter for sorted array (ex: if lLoop=5, each element 0-4 is already sorted and 5+ needs to be sorted)
Dim str1 As String, str2 As String      'Place holder for switching two elements' positions in an array when one has a lower sorted value
Dim rListPaste As Range                 'Stores location of the user-input destination

ReDim Preserve strArray(0)

Do While ActiveCell <> vbnullvalue

    If ActiveCell.Value = "Access Denied" Then
        GoTo Denied
    End If

    CurrentCell = ActiveCell.Value
    tempArray = Split(CurrentCell, " ")

    For i = LBound(tempArray) To UBound(tempArray)

        For elem = LBound(strArray) To UBound(strArray)
            'Used if strArray is empty
            If strArray(elem) = "" Then
                strArray(elem) = tempArray(i)
                GoTo NextTemp

            'If the current element in tempArray is already in strArray, go to next element in tempArray
            ElseIf InStr(tempArray(i), strArray(elem)) Then
                GoTo NextTemp

            'If all the elements in strArray have been searched and the element in tempArray is longer than 2 characters, _
            'then resize strArray and add the current tempArray element to strArray (after trimming extra spaces and returns)
            ElseIf elem = UBound(strArray) And Len(tempArray(i)) > 2 And tempArray(i) <> Chr(13) Then
                ReDim Preserve strArray(LBound(strArray) To UBound(strArray) + 1) As String
                strArray(UBound(strArray)) = Replace(Trim(tempArray(i)), vbLf, "")
            End If

        Next elem

NextTemp:       'Goes to next element in tempArray
    Next i

Denied:         'After both arrays have been compared, goto next cell below current active cell
    ActiveCell.Offset(1, 0).Select

Loop

'This loop sorts the strArray array
For lLoop = 0 To UBound(strArray)

    For lLoop2 = lLoop To UBound(strArray)

         If UCase(strArray(lLoop2)) < UCase(strArray(lLoop)) Then
             str1 = strArray(lLoop)
             str2 = strArray(lLoop2)
             strArray(lLoop) = str2
             strArray(lLoop2) = str1
         End If

    Next lLoop2

Next lLoop

Set rListPaste = Application.InputBox _
    (prompt:="Please select destination cell", Type:=8)

i = UBound(strArray) + 1
Range(rListPaste, rListPaste.Offset(i)).Value2 = WorksheetFunction.Transpose(strArray)

End Sub

Answer 1

我没有使用'预先添加每个值，而是在将数组放入目标范围之前而不是之后格式化文本的目标范围。我用了Range(rListPaste, rListPaste.Offset(lLoop - 1)).NumberFormat = "@"。这将消除对另一个循环步骤的需求。谢谢你的帮助！

防止将字符串数组重新格式化为科学

1 个答案: