Code:
Function Fu_snb(ByVal sn As Range, ByVal y As Long) As Variant
10 ' use "neat magic" code line arrOut() = Application.Index(arrIn(), rwsT(), clms()) http://www.excelforum.com/excel-new-users-basics/1099995-application-index-with-look-up-rows-and-columns-arguments-as-vba-arrays.html http://www.mrexcel.com/forum/excel-questions/908760-visual-basic-applications-copy-2-dimensional-array-into-1-dimensional-single-column-2.html#post4375354
20 ' So we have sn as a range sn, ( can be uses syntaxly for arrIn() in "neat magic" line. ). Consequtive columns indicies as simple transpose of consequtive row Indicies from Spreadsheet row Funnction. Row indicies as the consequtive row indicies with the row to be deleted taken out
30 ' so snb does arrOut() = Application.Index(sn, rwsT(), clms())
40
50
60 ' clms() = { 1, 2, 3, 4, 5 }
70 'clms()
80 Dim clms() As Variant: Let clms() = Evaluate("column(A1:E10)")
90 Let clms() = Evaluate("column(" & sn.Address & ")")
100 Dim sName As String: Let sName = "snb_002"
110 Let sn.Name = sName
120 Let clms() = Evaluate("column(" & sName & ")")
129 Let clms() = Evaluate("column(snb_002)")
130 '== DANGER: === Pitful: Above we gave the Range Object a Name, but now see what "Name" or "Name" 's comes back "!" !
132 Dim retRefstrName As String, retObjName As Object
133 Let retRefstrName = sn.Name: Set retObjName = sn.Name: Debug.Print sn.Name 'something of the form "NPueyoGyanArraySlicing!$A$1:$E$10" is reveald in Immediate ( Ctrl+G when in VB Editor ) Window
134 'Let clms() = Evaluate("column(=NPueyoGyanArraySlicing!$A$1:$E$10)") 'Let clms() = Evaluate("column(" & retRefstrName & ")")' Rintime Error 13: Incompatiblee types
135 Let clms() = Evaluate("column(NPueyoGyanArraySlicing!$A$1:$E$10)") 'Works
137 Dim NameOnly As String: Let NameOnly = Replace((sn.Name), "!", "", (InStr(1, (sn.Name), "!"))): 'Debug.Print sn.Name: Dim pos&: pos = InStr(1, (sn.Name), "!"): NameOnly = Replace((sn.Name), "!", "", pos) ' We had ---- "NPueyoGyanArraySlicing!$A$1:$E$10" This is a String referrece returned when the Name Object is used directly or set to a String Variable. so here I return a string that starts at the position of the ! and which replaces in that truncated shortened string - "!$A$1:$E$10" the "!" with nothing
138 Let clms() = Evaluate("column(" & NameOnly & ")"): Let clms() = Evaluate("column(" & Replace((sn.Name), "!", "", (InStr(1, (sn.Name), "!"))) & ")")
139
140 Dim strName As String: Let strName = sn.Name.Name: Debug.Print strName: Let strName = retObjName.Name: Debug.Print strName ' returns our original "CoN"
142 Let clms() = Evaluate("column(" & strName & ")")
150 Dim rngF1G2 As Range: Set rngF1G2 = Range("F1:G2"): Let Range("F1:G2").Value = "From Line 150"
151 Let Range("=NPueyoGyanArraySlicing!F1:G2").Value = "From Line 151"
152 Let rngF1G2.Name = "snFG": Let Range("snFG").Value = "From Line 152"
149 '===============
160 'rwsT() snb rws() = VBA.Split(Trim(Replace(" " & Join(Evaluate("transpose(row(A1:E10))")) & " ", " " & y & " ", " ")))
170 'Final required row Indicies, with a missing indicie, as a string ( Hard Copy )
180 Dim strrwsD As String
190 Let strrwsD = "1 2 3 4 6 7 8 9 10"
200 Let strrwsD = Replace("1 2 3 4 5 6 7 8 9 10", " 5 ", " ", 1)
210 Dim strRws As String: Let strRws = "1 2 3 4 5 6 7 8 9 10"
220 Let strrwsD = Replace(strRws, " 5 ", " ", 1)
230
240 'Get full sequential row conveniently from Row Function - ( correct "orientation" to use in "neat magic" code line, but wrong "orientation" to use Join Function {1; 2; 3; 4; 5; 6; 7; 8; 9; 10} )
250 Dim arr_2D1row() As Variant
260 Let arr_2D1row() = Evaluate("row(A1:E10)") ' 1 To 10, 1 To 1
270
280 'Get full sequential row string.
290 Let strRws = Join(Evaluate("transpose(row(A1:E10))"), " ") 'Join must have eindimensional Array, as given by transpose working on a 2D 1 column Array
300 Let strRws = Join(Application.Transpose((Evaluate("row(A1:E10)"))), " ")
310 Let strRws = Join(Application.Transpose((arr_2D1row())), " ") ' Join ( Transpose ( { 1; 2; 3; 4; 5; 6; 7; 8; 9; 10} ) ) = Join ( { 1, 2, 3, 4, 5, 6, 7, 8, 9, 10} )
320
330 'Final required row Indicies, with a missing indicie, as a string
340 Let strrwsD = Replace(strRws, " 5 ", " ", 1)
350 Let strrwsD = Replace(strRws, " " & y & " ", " ", 1)
360 'Split Final String by " " to get 1 1d "Pseudo Horizontal" Array
370 Dim rws() As String: Let rws() = VBA.Split(strrwsD, " ") ' 1 D Array
380 'Final Transposed Array for "magic neat" code line
390 Dim rwsT() As Variant: Let rwsT() = Application.Transpose(rws()) ' 2 D 1 "column" Array
400
440 'Output Array
450 Dim arrOut() As Variant
460 arrOut() = Application.Index(sn, rwsT(), clms())
470
480 Let Fu_snb = arrOut()
490 'Or
Let Fu_snb = Application.Index(sn, Application.Transpose(VBA.Split(Replace(Join(Application.Transpose((Evaluate("row(A1:E10)"))), " "), " " & y & " ", " ", 1), " ")), Evaluate("column(A1:E10)"))
'Finally the "extra" named range bit:
'Let sn.Name = "snb_002"
Let Fu_snb = Application.Index(sn, Application.Transpose(VBA.Split(Replace(Join(Application.Transpose((Evaluate("row(snb_002)"))), " "), " " & y & " ", " ", 1), " ")), Evaluate("column(snb_002)"))
' "Shorthand" evaluate
Let Fu_snb = Application.Index(sn, Application.Transpose(VBA.Split(Replace(Join(Application.Transpose(([row(snb_002)])), " "), " " & y & " ", " ", 1), " ")), [column(snb_002)])
'Let Fu_snb = Application.Index(sn, Application.Transpose(VBA.Split(Trim(Replace(" " & Join(Evaluate("transpose(row(snb_002))")) & " ", " " & y & " ", " ")))), Evaluate("column(snb_002)"))
'or
'Let Fu_snb = Application.Index(sn, Application.Transpose(Split(Trim(Replace(" " & Join([transpose(row(snb_002))]) & " ", " " & y & " ", " ")))), [column(snb_002)])
End Function
Reply With Quote
Bookmarks