2009
17.01.13,14:04
Dobrý deň
Je možné vytvoriť makro tak aby sa pozrelo na stĺpec B, za každou čiarkou pridalo nový riadok a vložilo tam všetky znaky za ňou?
A_________B
X00487 CHI,DCH,GCH
A_______B
X00487 CHI,
_______DCH,
_______GCH
Pokiaľ by sa vedelo pozrieť aj na stĺpec A a vkladať hodnoty so stĺpca A veľmi by mi to uľahčilo prácu
A_________B
X00487 CHI,DCH,GCH
A_______ B
X00487 CHI,
X00487 DCH,
X00487 GCH
Podrobnejšie v prílohe
Je možné vytvoriť makro tak aby sa pozrelo na stĺpec B, za každou čiarkou pridalo nový riadok a vložilo tam všetky znaky za ňou?
A_________B
X00487 CHI,DCH,GCH
A_______B
X00487 CHI,
_______DCH,
_______GCH
Pokiaľ by sa vedelo pozrieť aj na stĺpec A a vkladať hodnoty so stĺpca A veľmi by mi to uľahčilo prácu
A_________B
X00487 CHI,DCH,GCH
A_______ B
X00487 CHI,
X00487 DCH,
X00487 GCH
Podrobnejšie v prílohe
2009
17.01.13,13:11
V druhej záložke je príklad ako by to malo vyzerať v ideálnej podobe. Moc by mi to pomohlo aj keby sa nekopíroval stĺpec A
marjankaj
17.01.13,16:46
Sub Makro1()
Dim a
Application.ScreenUpdating = False
For i = Cells(Range("A:A").Cells.Count, 1).End(xlUp).Row To 1 Step -1
a = Split(Cells(i, 2), ",")
x = Cells(i, 1)
For j = LBound(a) To UBound(a)
If j <> UBound(a) Then
Cells(i + j, 2).Select
Selection.EntireRow.Insert
End If
Cells(i + j, 1) = x
Cells(i + j, 2) = a(j)
Next j
Next i
Application.ScreenUpdating = True
End Sub
Dim a
Application.ScreenUpdating = False
For i = Cells(Range("A:A").Cells.Count, 1).End(xlUp).Row To 1 Step -1
a = Split(Cells(i, 2), ",")
x = Cells(i, 1)
For j = LBound(a) To UBound(a)
If j <> UBound(a) Then
Cells(i + j, 2).Select
Selection.EntireRow.Insert
End If
Cells(i + j, 1) = x
Cells(i + j, 2) = a(j)
Next j
Next i
Application.ScreenUpdating = True
End Sub
2009
18.01.13,06:15
Sub Makro1()
Dim a
Application.ScreenUpdating = False
For i = Cells(Range("A:A").Cells.Count, 1).End(xlUp).Row To 1 Step -1
a = Split(Cells(i, 2), ",")
x = Cells(i, 1)
For j = LBound(a) To UBound(a)
If j <> UBound(a) Then
Cells(i + j, 2).Select
Selection.EntireRow.Insert
End If
Cells(i + j, 1) = x
Cells(i + j, 2) = a(j)
Next j
Next i
Application.ScreenUpdating = True
End Sub
Vďaka.
Funguje to perfektne. Už to mám hotové. Jednalo sa o 6 000 riadkov s ktorých mi vyšlo 49 000. Ak by som to robila spôsobom rozdeliť text na stĺpce a ručne vkladať riadky trvalo by to nekonečne dlho. Moc si mi pomohol :)
Dim a
Application.ScreenUpdating = False
For i = Cells(Range("A:A").Cells.Count, 1).End(xlUp).Row To 1 Step -1
a = Split(Cells(i, 2), ",")
x = Cells(i, 1)
For j = LBound(a) To UBound(a)
If j <> UBound(a) Then
Cells(i + j, 2).Select
Selection.EntireRow.Insert
End If
Cells(i + j, 1) = x
Cells(i + j, 2) = a(j)
Next j
Next i
Application.ScreenUpdating = True
End Sub
Vďaka.
Funguje to perfektne. Už to mám hotové. Jednalo sa o 6 000 riadkov s ktorých mi vyšlo 49 000. Ak by som to robila spôsobom rozdeliť text na stĺpce a ručne vkladať riadky trvalo by to nekonečne dlho. Moc si mi pomohol :)