trying create unique combinations of values each row given fact each each cell may or may not have multiple nested values. goal interpret each row , write new line each unique combination of values.
sub combo(x integer, splitcell boolean, lastcol long) dim cellarray() string dim ws worksheet set ws = thisworkbook.worksheets("test") y = lastcol 2 step -1 dim counter integer counter = 0 cellvalue = ws.cells(x, y).value cellarray() = split(cellvalue, chr(10)) debug.print cellvalue if ubound(cellarray()) > lbound(cellarray()) debug.print "splitting " & x, y t = ubound(cellarray()) lbound(cellarray()) step -1 rows(x + counter).offset(1).entirerow.insert counter = counter + 1 = lastcol 1 step -1 if = y ws.cells(x + counter, a).value = cellarray(t) splitcell = true rowtodel = x else ws.cells(x + counter, a).value = ws.cells(x, a).value splitcell = true end if next next t end if x = x + counter next y if splitcell = true rows(rowtodel).entirerow.delete end if x = x - 1 lastrow = ws.cells(rows.count, 1).end(xlup).row end sub
this code works case of having 1 cell nested values versus single entries in other cells in row. however, there cases of 3 columns each nested values unique entries should made for.
in below comments pretend data splitting comma-delimited. did because easier show examples using commas using tabs. code included still using tab delimiter.
if understand problem correctly, when have value of (for instance) "1,4,67" in column q, code correctly generating rows - 1 "1" in column q, 1 "4" in column q, , 1 "67" in column q, other columns copied original line.
however, when have second cell multiple comma-separated values, "a,b" in column t, "a,b" still appearing on each of first 2 generated rows, , being split on third row - creating total of 4 rows. want 6 rows generated instead (one each value of "a,b" each value of "1,4,67").
i'm assuming calling subroutine each row in original data.
the following code process line, expanding each of values every combination:
sub combo(x integer, splitcell boolean, lastcol long) dim cellarray() string dim ws worksheet set ws = thisworkbook.worksheets("sheet1") dim t long dim y long dim long dim cellvalue dim dstrow integer dim srcrow integer dim acellwassplit boolean srcrow = x dstrow = x splitcell = false while srcrow <= dstrow acellwassplit = false y = lastcol 2 step -1 cellvalue = ws.cells(x, y).value cellarray() = split(cellvalue, chr(10)) debug.print cellvalue if ubound(cellarray()) > lbound(cellarray()) debug.print "splitting " & x, y acellwassplit = true t = ubound(cellarray()) lbound(cellarray()) step -1 dstrow = dstrow + 1 rows(dstrow).entirerow.insert = lastcol 1 step -1 if = y ws.cells(dstrow, a).value = cellarray(t) else ws.cells(dstrow, a).value = ws.cells(srcrow, a).value end if next next t exit end if next y if acellwassplit ws.rows(srcrow).entirerow.delete dstrow = dstrow - 1 splitcell = true else srcrow = srcrow + 1 end if loop x = dstrow + 1 end sub
and following code can used test it:
sub test() dim anythingprocessed boolean dim currentrow integer dim lastcol long currentrow = 1 lastcol = 5 while currentrow <= thisworkbook.worksheets("sheet1").cells(rows.count, 1).end(xlup).row combo currentrow, anythingprocessed, lastcol loop end sub
Comments
Post a Comment