xman2000
10-19-2017, 11:20 PM
Hi Partners,
Array Filtered without Spaces after 1aRow
(Edit2: i dont want use Transpose()function -- please other more eficient ways of put (transpose) the values of array to cells (2d array with space before 1oLoop)
i want have space only before First Results 1o Loop of Array, next loops i need not put spaces between results values of Loopings.
example: 1oLoop (space - filtering by 4 row2) , 2oLoop (filtering by 5 next row) , 3oLoop (filtering by 6 next row),
my code put spaces, i want remove but i am not know without remove the space of 1oLoop.
please i want the code in text here more security.
thank you.
Edit2: i dont want use Transpose()function
edit: (please other more eficient ways of put (transpose) the values of array to cells (2d array with space before 1oLoop)
20706
Sub ArrayLoopSpaceOneFORUM1ok1()
''=================================================================
''=================================================================
Dim WayPts As Range ''XMAN200 EU TINHA ESQUECIDO ESTE NAS VERSOES ANTERIORES
Set WayPts = Range("A:B")
Dim WayPtsB As Range
Set WayPtsB = Range("B:B")
Dim WayPtsA As Range
Set WayPtsA = Range("A:A")
''=================================================================
Dim ColunaY As Range
Dim ColunaX As Range
Dim ColunaXMin As Range
Dim ContadorCelulas As Long
Dim totalCells As Long
Dim cel As Range
Dim celMin As Range
Set ColunaY = Range("B2:B2488") '''XMAN2000 PRECISO MUDAR PARA VINCULAR AO RANGE DE WAYPTS
Set ColunaX = Range("A2:A2488") '''XMAN2000 PRECISO MUDAR PARA VINCULAR AO RANGE DE WAYPTS
Set ColunaXMin = Range("A" & ColunaX.Row, "A" & ColunaX.Rows.Count - 1) '''XMAN2000 ESTA COLUNA PRECISA TER 1UMA CELULA LINHA A MENOS
''MsgBox "msgbox1 ColunaXMin " & ColunaXMin.Rows.Address
Dim ColunaYMinRows As Long
ColunaYMinRows = (ColunaY.Rows.Count) - 1 '''XMAN2000 ESTA COLUNA VIRA APENAS O NUMERO DA ROW E PRECISA TER 1UMA CELULA LINHA A MENOS
''MsgBox "msgbox2 ColunaYMinRows " & ColunaYMinRows
''---------------------------------------------------
Dim TotalCellsRowsCount As Long
TotalCellsRowsCount = ColunaY.Cells.Rows.Count
''MsgBox "TotalCellsRowsCount " & TotalCellsRowsCount
''=================================================================
Dim ValorLvalue As Long
For ValorLvalue = 4 To 6
Dim LinhaInicialAdicional As Long
'''LinhaInicialAdicional = LinhaInicialAdicional + 1
Dim Rng As Range, c As Range
Dim StudentMarks()
Dim n As Long
ReDim StudentMarks(1 To ColunaY.Count)
For Each c In ColunaY
If c.Value = ValorLvalue Then
n = n + 1
StudentMarks(n) = c.Row
End If
Next c
''========================================================
''========================================================
''========================================================
If StudentMarks(1) > 0 Then
End If
If StudentMarks(2) > 0 Then
End If
If StudentMarks(n) > 0 Then
End If
''========================================================================= =========
MsgBox "StudentMarks(n)" & StudentMarks(n)
MsgBox "(n)" & n
''MsgBox "(n+n)" & n + n
''Dim LinhaInicialAdicional As Long
LinhaInicialAdicional = LinhaInicialAdicional + 1
''For NQuant = n To n ''XMAN2000 N TO N retorna Apenas Ultimos Valores de Cada Scanline
For NQuant = 1 To n ''XMAN2000 N TO N retorna Apenas Ultimos Valores de Cada Scanline
ActiveSheet.Cells(LinhaInicialAdicional + NQuant, 3).Value = StudentMarks(NQuant)
Next
iValueFirst = 0
LinhaInicialAdicional = LinhaInicialAdicional + n
n = 0 ''XMAN2000 SOLUCAO(n=0) http://www.vbaexpress.com/forum/showthread.php?59251-Array-Relative-Erase-Variables-but-Next
Next ValorLvalue
' MsgBox "StudentMarks(n)" & StudentMarks(n)
''========================================================================= ==========
End Sub
Array Filtered without Spaces after 1aRow
(Edit2: i dont want use Transpose()function -- please other more eficient ways of put (transpose) the values of array to cells (2d array with space before 1oLoop)
i want have space only before First Results 1o Loop of Array, next loops i need not put spaces between results values of Loopings.
example: 1oLoop (space - filtering by 4 row2) , 2oLoop (filtering by 5 next row) , 3oLoop (filtering by 6 next row),
my code put spaces, i want remove but i am not know without remove the space of 1oLoop.
please i want the code in text here more security.
thank you.
Edit2: i dont want use Transpose()function
edit: (please other more eficient ways of put (transpose) the values of array to cells (2d array with space before 1oLoop)
20706
Sub ArrayLoopSpaceOneFORUM1ok1()
''=================================================================
''=================================================================
Dim WayPts As Range ''XMAN200 EU TINHA ESQUECIDO ESTE NAS VERSOES ANTERIORES
Set WayPts = Range("A:B")
Dim WayPtsB As Range
Set WayPtsB = Range("B:B")
Dim WayPtsA As Range
Set WayPtsA = Range("A:A")
''=================================================================
Dim ColunaY As Range
Dim ColunaX As Range
Dim ColunaXMin As Range
Dim ContadorCelulas As Long
Dim totalCells As Long
Dim cel As Range
Dim celMin As Range
Set ColunaY = Range("B2:B2488") '''XMAN2000 PRECISO MUDAR PARA VINCULAR AO RANGE DE WAYPTS
Set ColunaX = Range("A2:A2488") '''XMAN2000 PRECISO MUDAR PARA VINCULAR AO RANGE DE WAYPTS
Set ColunaXMin = Range("A" & ColunaX.Row, "A" & ColunaX.Rows.Count - 1) '''XMAN2000 ESTA COLUNA PRECISA TER 1UMA CELULA LINHA A MENOS
''MsgBox "msgbox1 ColunaXMin " & ColunaXMin.Rows.Address
Dim ColunaYMinRows As Long
ColunaYMinRows = (ColunaY.Rows.Count) - 1 '''XMAN2000 ESTA COLUNA VIRA APENAS O NUMERO DA ROW E PRECISA TER 1UMA CELULA LINHA A MENOS
''MsgBox "msgbox2 ColunaYMinRows " & ColunaYMinRows
''---------------------------------------------------
Dim TotalCellsRowsCount As Long
TotalCellsRowsCount = ColunaY.Cells.Rows.Count
''MsgBox "TotalCellsRowsCount " & TotalCellsRowsCount
''=================================================================
Dim ValorLvalue As Long
For ValorLvalue = 4 To 6
Dim LinhaInicialAdicional As Long
'''LinhaInicialAdicional = LinhaInicialAdicional + 1
Dim Rng As Range, c As Range
Dim StudentMarks()
Dim n As Long
ReDim StudentMarks(1 To ColunaY.Count)
For Each c In ColunaY
If c.Value = ValorLvalue Then
n = n + 1
StudentMarks(n) = c.Row
End If
Next c
''========================================================
''========================================================
''========================================================
If StudentMarks(1) > 0 Then
End If
If StudentMarks(2) > 0 Then
End If
If StudentMarks(n) > 0 Then
End If
''========================================================================= =========
MsgBox "StudentMarks(n)" & StudentMarks(n)
MsgBox "(n)" & n
''MsgBox "(n+n)" & n + n
''Dim LinhaInicialAdicional As Long
LinhaInicialAdicional = LinhaInicialAdicional + 1
''For NQuant = n To n ''XMAN2000 N TO N retorna Apenas Ultimos Valores de Cada Scanline
For NQuant = 1 To n ''XMAN2000 N TO N retorna Apenas Ultimos Valores de Cada Scanline
ActiveSheet.Cells(LinhaInicialAdicional + NQuant, 3).Value = StudentMarks(NQuant)
Next
iValueFirst = 0
LinhaInicialAdicional = LinhaInicialAdicional + n
n = 0 ''XMAN2000 SOLUCAO(n=0) http://www.vbaexpress.com/forum/showthread.php?59251-Array-Relative-Erase-Variables-but-Next
Next ValorLvalue
' MsgBox "StudentMarks(n)" & StudentMarks(n)
''========================================================================= ==========
End Sub