如何拆分单元格

Question

我想知道是否有办法将图像列表中的单元格拆分为8个字符段，将每个8个字符放在sheet2上，并为每一行包含field1，field2，field3？

IDNUM   FIELD1  FIELD2  FIELD3  CONVSTATUS  DUPEID  IMAGELIST
7   Person1 07/20/1982  20321   4   0   000001370000013900000140000001410000014200000143000001440000014500000146000001470000014800000149000001500000015100000152000001530000015400000155000001560000015700000158000001590000016000000161000001620000016300000164000001650000016600000167000001680000016
8   Person2 08/20/1984  240761  4   1   000002030000020400000205000002060000020700000208000002090000021000000212000002160000021700000218000002190000022000000221000002220000022300000224000002250000022600000227000002280000022900000230000002310000023200000233000002340000023500000236000002370000023
9   Person3 09/13/1986  240762  4   1   00000403000004040000040500000406000004070000040800000409000004100000041200000416
​

这是我希望最终归档的内容。 （由于图像列表缩短了可以非常大的尺寸）

Person1 07/20/1982  20321   00000137
Person1 07/20/1983  20322   00000139
Person1 07/20/1984  20323   00000140
Person2 08/20/1984  240761  00000203
Person2 08/20/1984  240761  00000204
Person2 08/20/1984  240761  00000205
Person3 09/13/1986  240762  00000403
Person3 09/13/1986  240762  00000404
Person3 09/13/1986  240762  00000405

Answer 1

在A1中使用 IDNUM （根据示例图像），运行此代码。

Sub split_img_set()
    Dim rw As Long, lr As Long, v As Long, vi As Long, vVALs As Variant

    With ActiveSheet   '<-set this worksheet reference properly!!
        lr = .Cells(Rows.Count, 2).End(xlUp).Row
        .Cells(lr + 3, 2).Resize(1, 4) = Array(.Cells(1, 2).Value, .Cells(1, 3).Value, .Cells(1, 3).Value, "IMAGES")
        For rw = 2 To lr
            vVALs = .Cells(rw, 2).Resize(1, 6).Value
            vi = Len(vVALs(1, UBound(vVALs, 2)))
            For v = 1 To vi Step 8
                .Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Resize(1, 3) = Array(vVALs(1, 1), vVALs(1, 2), vVALs(1, 3))
                .Cells(Rows.Count, 2).End(xlUp).Offset(0, 3).NumberFormat = "@"
                .Cells(Rows.Count, 2).End(xlUp).Offset(0, 3) = Mid(vVALs(1, UBound(vVALs, 2)), v, 8)
            Next v
        Next rw
    End With
End Sub

将在现有值下创建结果。可能存在发布错误，但前两个示例IMAGELIST值不可直接被 8 整除，长度为 255 个字符。

Answer 2

以下是您开始使用的代码段（假设您正在从Sheet1复制到Sheet2）：

Sub Test2()
Dim wsSheet As Worksheet
Set wsSheet = ActiveWorkbook.Worksheets("Sheet1")
Dim LastRow As Integer, RowsToCopy As Integer, Counter As Integer, Step As Integer, ILCol As Integer
ILCol = 4
Counter = 2
LastRow = wsSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious, After:=[A1]).Row
For i = 2 To LastRow
    RowsToCopy = Len(wsSheet.Cells(i, ILCol)) / 8
    Step = 1
    For t = 1 To RowsToCopy
        ActiveWorkbook.Sheets("Sheet2").Cells(Counter, 4).Value = CStr(Mid(wsSheet.Cells(i, ILCol).Value, Step, 8))
        Step = Step + 8
        Counter = Counter + 1
    Next t
Next i

End Sub

只需将ILCol = 4更改为IMAGELIST列所在的任何列。您仍然必须在循环中写入以复制其他列，然后将新列格式化为＆＃34; 00000000＆＃34 ;，但这应该是一个好的开始。