Mrrrr's Forum (VIEW ONLY)
Un forum care ofera solutii pentru unele probleme legate in general de PC. Pe langa solutii, aici puteti gasi si alte lucruri interesante // A forum that offers solutions to some PC related issues. Besides these, here you can find more interesting stuff.
|
Lista Forumurilor Pe Tematici
|
Mrrrr's Forum (VIEW ONLY) | Reguli | Inregistrare | Login
POZE MRRRR'S FORUM (VIEW ONLY)
Nu sunteti logat.
|
Nou pe simpatie:
ro_xy20
 | Femeie
24 ani
Bucuresti
cauta Barbat
24 - 45 ani |
|
Mrrrr
AdMiN
 Inregistrat: acum 17 ani
Postari: 2186
|
|
VBA (no source, made it myself)
The lengths of your ranges (in rows) really don't matter. In the same way you can add to the code and stack even more columns.
Assuming you have the same data as the image below (non VBA) for the initial table, data starting in A3 to B9 and result needed to start from C3:
Sub ColumnStacking1()
Application.ScreenUpdating = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' NOTE: THIS IS LETTING YOU KNOW THAT THERE IS DATA IN COLUMN C AND YOU WILL ERASE IT
If Range("C3").Value <> "" Then
If MsgBox("Esti sigura ca vrei sa rulezi programul din nou? Datele din coloana vor fi sterse si vor fi inlocuite cu altele noi.", _
vbYesNo + vbQuestion) = vbYes Then
Columns("C").ClearContents
Else: Exit Sub
End If
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim LastrowA As Long
Dim LastrowB As Long
Dim FirstFree As Long
LastrowA = Cells(Rows.Count, "A").End(xlUp).Row
LastrowB = Cells(Rows.Count, "B").End(xlUp).Row
Range("C3").Select
Range("A3:A" & LastrowA).Copy Destination:=ActiveCell
FirstFree = Range("C3:C" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row
Range("C" & FirstFree).Select
Range("B3:B" & LastrowB).Copy Destination:=ActiveCell
Application.ScreenUpdating = True
End Sub |
Source NON-VBA
NOTE: Your columns must be equal in length (same number of rows with data).
Initial table with formulas in A2 and B2 to count how many values are in each Row. B2 because you need to make sure your row count is equal to the one in column A.
Now we need 3 helper columns (col D, E, F + the result column (col. G).
- column D - the value in D3 is 0 (zero). Just type zero in D3; then in D4 type the formula from D2. Column D is used to create a suite of numbers running from zero up to the total number of values minus 1 (A2+B2-1), drag down until value is blank
- column E - in E3 type the formula from E2, then drag down until value is blank
- column F - in F3 type the formula from F2, then drag down until value is blank
- column G - in G3 type the formula from G2, then drag down until value is blank
Column G is your result, column A stacked over column B.
_______________________________________
|
|
| pus acum 5 ani |
|
|
TRaP
Moderator
Inregistrat: acum 6 ani
Postari: 748
|
|
This one stacks 4 different columns depending on last row of one of them (assuming the rest have formulas that go below that row):
Sub ColumnStacking()
Application.ScreenUpdating = False
Dim Lastrow As Long
Dim FirstFree As Long
Dim ws As Worksheet
Set ws = Worksheets("LDM tabla_produs")
ws.Range("AC:AF").ClearContents
With ws
Lastrow = Cells(Rows.Count, "P").End(xlUp).Row
Range("AC1").Value = "MIEZ"
Range("AD1").Value = "Tip produs"
Range("AE1").Value = "Tabla"
Range("AF1").Value = "Total kg"
Range("AC2").Select
Range("Q2:Q" & Lastrow).Copy
ActiveCell.PasteSpecial Paste:=xlPasteValues
FirstFree = Range("AC2:AC" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row
Range("AC" & FirstFree).Select
Range("W2:W" & Lastrow).Copy
ActiveCell.PasteSpecial Paste:=xlPasteValues
Range("AD2").Select
Range("R2:R" & Lastrow).Copy
ActiveCell.PasteSpecial Paste:=xlPasteValues
FirstFree = Range("AD2:AD" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row
Range("AD" & FirstFree).Select
Range("X2:X" & Lastrow).Copy
ActiveCell.PasteSpecial Paste:=xlPasteValues
Range("AE2").Select
Range("U2:U" & Lastrow).Copy
ActiveCell.PasteSpecial Paste:=xlPasteValues
FirstFree = Range("AE2:AE" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row
Range("AE" & FirstFree).Select
Range("Z2:Z" & Lastrow).Copy
ActiveCell.PasteSpecial Paste:=xlPasteValues
Range("AF2").Select
Range("V2:V" & Lastrow).Copy
ActiveCell.PasteSpecial Paste:=xlPasteValues
FirstFree = Range("AF2:AF" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row
Range("AF" & FirstFree).Select
Range("AA2:AA" & Lastrow).Copy
ActiveCell.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With
ActiveSheet.Range("A1").Select
Application.ScreenUpdating = True
End Sub |
Modificat de TRaP (acum 5 ani)
|
|
| pus acum 5 ani |
|
|
TRaP
Moderator
Inregistrat: acum 6 ani
Postari: 748
|
|
Source @ DerbyDad03:
'Twere it me, I'd use:
Range("A3:A" & LastrowA).Copy Range("C3")
and
Range("B3:B" & LastrowB).Copy Range("C" & LastrowC + 1) |
BTW...This can be done with a formula, although determining where to stop dragging the formula is kind of manual.
Put this in C3 and drag it down as far as you think you'll need and then keep going ;-). It's OK to drag it down too far because you'll just get blank cells. Obviously, if you don't drag it down far enough, you'll miss some values.
=IF(ROW()>SUM(COUNTA(A:A);COUNTA(B:B);2);"";IF(A3<>"";A3;INDIRECT("B"&ROW()-COUNTA(A:A))))
Basically, you must drag it down to at least 2 rows beyond the number of values in Column A plus the number of values in Column B. In your example, you have 7 + 6 = 13 values, so you must drag it down to at least Row 15 to get the entire list. |
|
|
| pus acum 5 ani |
|
|
TRaP
Moderator
Inregistrat: acum 6 ani
Postari: 748
|
|
Source @ DerbyDad03:
You are making life too hard on yourself (and VBA).
There is no need to .Select a cell to use it as the Paste location. There is rarely a need to .Select a cell in VBA when performing an operation on it.
Two instructions are all that are needed:
Sub StackEm()
Range("A3:A" & Cells(Rows.Count, "A").End(xlUp).Row).Copy _
Range("C3")
Range("B3:B" & Cells(Rows.Count, "B").End(xlUp).Row).Copy _
Range("C" & Cells(Rows.Count, "C").End(xlUp).Row + 1)
End Sub |
|
|
| pus acum 5 ani |
|
