如何拆分单元格

我想知道是否有办法将imagelist中的单元格分成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 ​ 

这是我最后希望归档的东西。 (由于imagelist的缩小可能会非常大)

 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 

使用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 

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

这里有一个代码片段让你开始使用(假设你从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列所在的任何列即可。您仍然必须在循环中写入以复制其他列,然后将新列格式化为“00000000”,但这应该是一个好的开始。