< návrat zpět

MS Excel


Téma: VBA - kopírování určitých buněk rss

Zaslal/a 9.1.2017 18:30

Zdravím,
potřebuji poradit s tímto VBA.
Cca 1000 řádků a 10 sloupců dat v List1. V 11 sloupci je pouze v některých řádcích znak x. Moc bych potřeboval kod, po kterém se data ze sloupce C,D,E,F v řádcích kde je to x překopírují do List2 a potom jsou tyto řádky v List1 smazány.Mám pouze kod na to mazání:
Set Rng = Range("K2:1000")
i = 1
For counter = 1 To Rng.Rows.Count
If Rng.Cells(i) = "x" Then
i = i + 1
Else
Rng.Cells(i).EntireRow.Delete

End If
Next
End Sub

Moc díky!

Zaslat odpověď >

Strana:  1 2   další »
#034361
avatar
ještě jednou moc prosím, nenašel by se někdo z místních guru, kdo by mě s tím pomohl, moc děkujicitovat
#034362
Stalker
Ahoj vyzkoušej tento kód (na kopii sešitu).
Sub kopiruj_a_vymaz()

Dim i As Long
Dim maxRadek As Long

Application.ScreenUpdating = False
maxRadek = List1.Cells(Rows.Count, 1).End(xlUp).Row

For i = maxRadek To 1 Step -1
If List1.Cells(i, 11).Value = "x" Then
List2.Range("A1").EntireRow.Insert
List1.Range("C" & i & ":" & "F" & i).Copy List2.Range("A1:D1")
List1.Rows(i).EntireRow.Delete
End If
Next i
Application.ScreenUpdating = True
End Sub
citovat
#034369
avatar
WOW! Funguje parádně. Děkuji. Ještě otázka, jak by vypadal zápis, kdybych ty data potřeboval ze sloupců A,D,F,H,J?citovat
#034375
Stalker
Např:
Sub kopiruj_a_vymaz_2()

Dim i As Long
Dim maxRadek As Long
Dim Oblast As Range

Application.ScreenUpdating = False

maxRadek = List1.Cells(Rows.Count, 1).End(xlUp).Row

For i = maxRadek To 1 Step -1

Set Oblast = Union(List1.Cells(i, 1), List1.Cells(i, 4), List1.Cells(i, 6), List1.Cells(i, 8), List1.Cells(i, 10)) 'výběr buněk ve sloupcích A D F H J

If List1.Cells(i, 11).Value = "x" Then
List2.Range("A1").EntireRow.Insert
Oblast.Copy List2.Range("A1:E1")
List1.Rows(i).EntireRow.Delete
End If
Next i

Application.ScreenUpdating = True

End Sub
citovat
icon #034379
avatar
WOW!? Prečo písať script na niečo, čo zvládne rozšírený filter? Resp. prečo nepoužiť za základ scriptu v tomto prípade práve rozšírený filter?
Btw, ten kód v úvode vlákna je chybný (Range("K2:1000")) a i po oprave range určite nerobí to, čo popisuješ, že akože robí..citovat
#034404
avatar
@AL
Veď ani nepísal, že mu ten kód funguje. Iba ho má napísaný 2citovat
#034414
avatar
@Stalker - paráda, funguje to moc krásně. Moc děkuji. Jen bych potřeboval dvě, pro vás určitě maličkosti. Potřeboval bych kopírovat jen data (bez formátování) a potom bych potřeboval "zamíchat" buňky. Jak prostě dostat sloupec A Listu1 do Listu2, ale do sloupce B. Zamíchal jsem pořadí v kodu takto, ale to je hloupost. S VBA začínám a toto je pro mě vyšší dívčí, tak se nezlobte a děkuji. 1
Set Oblast = Union(List1.Cells(i, 4), List1.Cells(i, 1), List1.Cells(i, 6), List1.Cells(i, 8), List1.Cells(i, 10))citovat
#034424
avatar
Potřebuji už jen poradit, jak kopírovat pouze hodnoty buněk, bez podmínečného formátování? Pomůže prosím někdo?citovat
#034425
Stalker
S kopírováním pouze hodnot bez formátů není problém, ale k tomu prohození sloupců mě nenapadlo lepší řešení než pouze takto na "hulváta", možná se objeví znalejší s lepším postupem.
Sub kopiruj_a_vymaz_2()

Dim i As Long
Dim maxRadek As Long
Dim Oblast As Range

Application.ScreenUpdating = False

maxRadek = List1.Cells(Rows.Count, 1).End(xlUp).Row

For i = maxRadek To 1 Step -1
Set Oblast = Union(List1.Cells(i, 6), List1.Cells(i, 8), List1.Cells(i, 10)) 'výběr buněk ve sloupcích F H J

If List1.Cells(i, 11).Value = "x" Then
List2.Range("A1").EntireRow.Insert
List1.Cells(i, 1).Copy
List2.Cells(1, 2).PasteSpecial Paste:=xlPasteValues
List1.Cells(i, 4).Copy
List2.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
Oblast.Copy
List2.Range("C1:E1").PasteSpecial Paste:=xlPasteValues
List1.Rows(i).EntireRow.Delete
End If
Next i
Application.CutCopyMode = False
Set Oblast = Nothing
Application.ScreenUpdating = True
End Sub
citovat
#034426
avatar
@Stalker - Moc děkuji. Mohu poprosit ještě o poslední finální verzi. Prohození sloupců jsem vyřešil jinak, změnou ve zdrojovém Listu1. Takže stačí upravit to kopírování pouze hodnot v té verzi: kopiruj_a_vymaz_2. Ještě jednou velké díky za pomoc a trpělivost.citovat

Strana:  1 2   další »

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Aktivní diskuse

Zaokrouhlování

JoKe • 14.6. 15:19

Zaokrouhlování

Mirek-Kraus • 14.6. 13:52

excell uprava riadku vzorca

veny • 14.6. 7:52

excell uprava riadku vzorca

orangezradca • 13.6. 20:37

pomala tlac s exelu

jano5 • 12.6. 9:44

GRAF teploty

JoKe • 12.6. 9:22

Filtrování dat

Imh0tep • 12.6. 8:35