Some extra notes for this main forum post:
http://www.eileenslounge.com/viewtopic.php?f=27&t=38331
This is a sample input,
_____ Workbook: Split- Copy.xlsm ( Using Excel 2007 32 bit )
Worksheet: Sheet2Original
Row\Col A B 21,2,3,4 t,y,u,m
This is what I want out
_____ Workbook: Split- Copy.xlsm ( Using Excel 2007 32 bit )
Worksheet: Sheet2
Row\Col A B 2 1t 3 2y 4 3u 5 4m
I want to do this sort of thing,
__ arrOut()= App.Index(arrIn(), Rws(), Clms())
The arrIn() in this case will be all the input data. Conveniently, we can join the two cell values with a comma then split all that by comma to get a single array, {1 2 3 4 t y u m }
Then we need the Rws() like this
1 1
1 1
1 1
1 1
and the Clms() like this
1 5
2 6
3 7
4 8
Code:' https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=16639&viewfull=1#post16639 Sub SplitData4() Dim Ws2 As Worksheet: Set Ws2 = ThisWorkbook.Worksheets.Item("Sheet2") Dim strDta As String: Let strDta = Ws2.Range("A2").Value & "," & Ws2.Range("B2").Value Dim arrIn() As String Let arrIn() = Split(strDta, ",", -1, vbBinaryCompare) ' Or arrIn() = Split(Range("A2").Value & "," & Range("B2").Value, ",") Dim Rws() As Variant Let Rws() = Evaluate("=Row(1:4)/Row(1:4)*Column(A:B)/Column(A:B)") Let Rws() = Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")/Row(1:" & (UBound(arrIn()) + 1) / 2 & ")*Column(A:B)/Column(A:B)") Dim Clms() As Variant Let Clms() = Evaluate("=Row(1:4)+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")") Let Clms() = Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")") Dim arrOut() As Variant Let arrOut() = Application.Index(arrIn(), Rws(), Clms()) Let Ws2.Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = arrOut() ' Or ' Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = arrOut() ' Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = Application.Index(arrIn(), Rws(), Clms()) ' Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = Application.Index(arrIn(), Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")/Row(1:" & (UBound(arrIn()) + 1) / 2 & ")*Column(A:B)/Column(A:B)"), Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")")) Range("A2").Resize((UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2, 2).Value = Application.Index(Split(Range("A2").Value & "," & Range("B2").Value, ","), Evaluate("=Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")/Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")*Column(A:B)/Column(A:B)"), Evaluate("=Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")")) End SubCode:Sub StantiallyBeautiful() ' http://www.eileenslounge.com/viewtopic.php?f=27&t=38331 Range("A2").Resize((UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2, 2).Value = Application.Index(Split(Range("A2").Value & "," & Range("B2").Value, ","), Evaluate("=Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")/Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")*Column(A:B)/Column(A:B)"), Evaluate("=Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")")) End Sub
In actual fact, we can simplify things a bit , since Intersexual interception theory tells us that if Excel is looking for the indicies of this form
A b
C d
E f
G h
, but we only give it
1
, then it will see this instead
1 1
1 1
1 1
1 1
So that means we can replace Rws() with just 1
So that all simplifies it a bit…
Code:Sub SplitData4b() Dim Ws2 As Worksheet: Set Ws2 = ThisWorkbook.Worksheets.Item("Sheet2") Dim strDta As String: Let strDta = Ws2.Range("A2").Value & "," & Ws2.Range("B2").Value Dim arrIn() As String Let arrIn() = Split(strDta, ",", -1, vbBinaryCompare) ' Or arrIn() = Split(Range("A2").Value & "," & Range("B2").Value, ",") 'Dim Rws() As Variant ' Let Rws() = Evaluate("=Row(1:4)/Row(1:4)*Column(A:B)/Column(A:B)") ' Let Rws() = Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")/Row(1:" & (UBound(arrIn()) + 1) / 2 & ")*Column(A:B)/Column(A:B)") Dim Clms() As Variant Let Clms() = Evaluate("=Row(1:4)+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")") Let Clms() = Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")") Dim arrOut() As Variant ' Let arrOut() = Application.Index(arrIn(), Rws(), Clms()) Let arrOut() = Application.Index(arrIn(), 1, Clms()) Let Ws2.Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = arrOut() ' Or ' Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = arrOut() ' Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = Application.Index(arrIn(), 1, Clms()) ' Range("A2").Resize((UBound(arrIn()) + 1) / 2, 2).Value = Application.Index(arrIn(), 1, Evaluate("=Row(1:" & (UBound(arrIn()) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(arrIn()) + 1) / 2 & ")")) Range("A2").Resize((UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2, 2).Value = Application.Index(Split(Range("A2").Value & "," & Range("B2").Value, ","), 1, Evaluate("=Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")")) End Sub Sub StantiallyBeautifulb() ' http://www.eileenslounge.com/viewtopic.php?f=27&t=38331 Range("A2").Resize((UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2, 2).Value = Application.Index(Split(Range("A2").Value & "," & Range("B2").Value, ","), 1, Evaluate("=Row(1:" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")+((Column(A:B)-1)*" & (UBound(Split(Range("A2").Value & "," & Range("B2").Value, ",")) + 1) / 2 & ")")) End Sub




Reply With Quote
Bookmarks