Копирование одной ячейки, полной данных, в столбец? - PullRequest
0 голосов
/ 25 января 2019

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

Я попытался скопировать ячейку и вставить ее, используя функцию диапазона, а также просто используя первую ячейку столбца, который я хочу использовать.

ws3.Activate
FinalRow2 = ws3.Range("E200").End(xlUp).Row
c = 21
a = 0

While a < VehCount

    VIN2 = VehArray(a)

    For b = 2 To FinalRow2
        ws3.Activate
            If Cells(b, 5) = VIN2 Then     'If VIN matches database
            Cells(b, 7).Copy               'Copy cell with array data
            ws4.Activate                   'Fault tab
            Cells(6, c).Paste              'Paste down column c     
            c = c + 9                      'increment c     
        End If
        ActiveCell.Offset(1, 0).Activate        'move down while scanning 
    Next b

    a = a + 1               'counter for VIN in VehArray

Wend

Ячейки (6, c). Паста - это один из вариантов, который я пробовал, я также пробовал Range (TOP Cell, BOTTOM Cell) .PasteSpecial с неправильным результатом.

Что в ячейке, которую я хочу передать, составляет 840 байт данных, и они разнесены. Я хочу, чтобы каждый байт вставлялся в свою ячейку вниз в столбце c на другом листе.

Упомянутая ячейка, содержащая массив байтов, выглядит примерно как 17 5 5b 35. .... и так далее. 840 байтов в одной ячейке. Его больше нет в массиве, потому что я использую другую подпрограмму.

Ответы [ 2 ]

0 голосов
/ 25 января 2019

Помогает ли это?

enter image description here

Sub SampleStr840byte()
Dim myArray() As String
Dim SampleString As String
Dim iCt As Long

'Sample String 80 byte
'BB B2 4A 3E F9 F4 88 68 80 67 A8 2D 39 6E 8F E1 61 7E 03 A7 71 3C 21 B2 1F B9 D1 04 B1 CB 73 2D 31 A9 C3 AB 86 DB 2A 38 51 76 E3 21 34 11 A5 E3 9D C3 81 64 3A 60 4A 39 DF A7 16 C2 FD 15 3D 84 81 92 01 49 23 E0 C6 A1 75 C0 BE 2F 39 80 35 EA

'SampleString = "BB B2 4A 3E F9 F4 88 68 80 67 A8 2D 39 6E 8F E1 61 7E 03 A7 71 3C 21 B2 1F B9 D1 04 B1 CB 73 2D 31 A9 C3 AB 86 DB 2A 38 51 76 E3 21 34 11 A5 E3 9D C3 81 64 3A 60 4A 39 DF A7 16 C2 FD 15 3D 84 81 92 01 49 23 E0 C6 A1 75 C0 BE 2F 39 80 35 EA "



'I did save a 840 byte string in the cell A1!
SampleString = Range("A1").Value

myArray = Split(SampleString, " ")
MsgBox (sizeOfArray(myArray()))

For iCt = 1 To UBound(myArray)
Cells(iCt + 2, 3) = "'" & myArray(iCt - 1)
Next 'i

End Sub





'PROBLEM still existing? I haven't tried!
'
'Range(Cells(1, 3), Cells(UBound(myArray), 3)) = myArray()
'This works only for a length of 1823 bytes
'(see http://support.microsoft.com/?scid=kb;en-us;832136)
'Data May Be Truncated After 1,835 Characters When You Transfer Array Data to Cells in an Excel Worksheet



Function sizeOfArray(arr As Variant) As String
    Dim str As String
    Dim numDim As Integer
    Dim i

    numDim = NumberOfArrayDimensions(arr)
    str = "Array"

    For i = 1 To numDim
        str = str & "(" & LBound(arr, i) & " To " & UBound(arr, i)
        If Not i = numDim Then
            str = str & ", "
        Else
            str = str & ")"
        End If
    Next i

    sizeOfArray = str
End Function


Private Function NumberOfArrayDimensions(arr As Variant) As Integer
' By Chip Pearson
' http://www.cpearson.com/excel/vbaarrays.htm
Dim Ndx As Integer
Dim Res As Integer
On Error Resume Next
' Loop, increasing the dimension index Ndx, until an error occurs.
' An error will occur when Ndx exceeds the number of dimension
' in the array. Return Ndx - 1.
    Do
        Ndx = Ndx + 1
        Res = UBound(arr, Ndx)
    Loop Until Err.Number <> 0
NumberOfArrayDimensions = Ndx - 1
End Function

Sub arrSizeTester()
    Dim arr(1 To 2, 3 To 22, 2 To 9, 12 To 18) As Variant
    Debug.Print sizeOfArray(arr())
End Sub
0 голосов
/ 25 января 2019

Пример:

Dim arr

arr = Split(ws3.Cells(1, 1).Value, " ")

ws4.Cells(1, 1).Resize(UBound(arr) + 1, 1).Value = Application.Transpose(arr)

Обратите внимание, что вы не должны полагаться на активацию листов для ссылки на ячейки на листах - вы можете использовать лист непосредственно для квалификации ваших Cells / Range вызовов

...